Excel - komentáře s obrázky

Komentáře v buňkách v Excelu jsou dobře známou záležitostí a s jejich přidáváním, odebíráním či úpravou není problém. Pomocí pář klepnutí myši můžeme komentářům nastavit barvu pozadí, či **jako pozadí použít libovolný obrázek**. Potřebujeme-li přidat komentář s obrázekm na pozadí k několika desítkám buněk, je to práce na dlouho. Pro tyto účely nám poslouží makro.

Stáhnout vzorový sešit (zip, 107 kB), 17. 3. 10

Postup

Příprava obrázků

• Obrázky, které chceme přiřadit jako pozadí komentářů umístíme do jedné složky.

Příprava sešitu

• Vytvoříme nový sešit, kde do buněk uvedeme názvy obrázků (bez přípony).
• Sešit uložíme do stejné složky, kde jsou připravené obrázky.

Vložení makra

• Klávesovou zkratkou Alt + F11 se dostaneme do editoru VBA.
• Pravým tlačítkem myši klepneme na aktivní sešit v levé části okna.
• Z nabídky vybereme položku Insert, Module.
• Do zobrazeného okna vložíme kód (viz vzorový sešit).

Option Explicit
Sub pridej()

Application.ScreenUpdating = False
On Error Resume Next
'definování proměnných
Dim rBunka As Range
Dim sOblast As String, sPripona As String
    sOblast = "A1:A5"  'oblast buněk, ke kterým se mají přiřadit komentáře
    sPripona = ".jpg"  'formát obrázků, které budou tvořit pozadí komentářů

'vymazání komentářů
Range(sOblast).ClearComments

For Each rBunka In Range(sOblast)

    'podmínka 1: buňka není prázdná
    If rBunka <> vbNullString Then
            Dim lVyska As Long, lSirka As Long
            Dim sCesta As String
                sCesta = ThisWorkbook.Path & "\" & rBunka.Value & sPripona

            'vložení a odstranění obrázku pro definování velikosti komentáře
            With ActiveSheet.Pictures.Insert(sCesta)
                lVyska = .Height
                lSirka = .Width
               .Delete
            End With

            'vložení komentáře
            With rBunka
                .AddComment
                With .Comment.Shape
                    .Width = lSirka
                    .Height = lVyska
                    .Fill.UserPicture (sCesta)
                    .Visible = msoFalse
                    .Shadow.Visible = msoFalse
                End With
                .Comment.Visible = False
            End With

            'pokud není obrázek nalezen, vymaž komentář a pokračuj v kódu
            If Err <> 0 Then
                rBunka.ClearComments
            End If
            Err.Clear

    End If 'podmínka 1

Next rBunka

Application.ScreenUpdating = True

End Sub

• V kódu nastavíme správnou oblast buněk, do kterých se budou komentáře vkládat a příponu obrázků, které budou použity jako pozadí komentářů.

Spuštění makra

• Klávesou F5 makro spustíme.
• Zavřeme editor (Alt + F4), komentáře by se měly zobrazit v buňkách.