EXCEL - makro na zobrazení obrázku po najetí kurzoru Vyřešeno

[cherralie]

Zdravím všechny,

řeším v práci jednu vychytávku (pro me :-)). Potřebovala bych pomoci s vytvořením makra, které by po najetí kurzoru na odkaz (buňku) zobrazilo někde v prostoru obrázek (nejlépe vpravo v rohu nad danou buňkou), obdobně jako tomu je u komentářů, kdy v pravém horním rohu najedu myší na červený trojúhleník a objeví se mi koment.

Předem moc děkuji za pomoc
Lucie

[Reklama]

[d1amond]

Vítej na PC-HELP

Bude to jeden konkrétní obrázek nebo nějaký produktový pro každou vybranou buňku jiný?
Nevím totiž, jak chceš identifikovat konkrétní obrázek k příslušné buňce. Obrázek má nějaký název a teď je třeba ten název někde uvést - v samotném VBA kódu na pevno nebo se může čerpat jako hodnota z buňky samotné.
Příklad, v buňce A1 bude text kacenka. V kódu bude uvedeno "C:\Obr\" & Cell.Value & ".gif". Potom lze pracovat s obrazkem kacenka.gif. Nebo lze Cell.Value nahradit jen názvem, ale potom to bude otrocká práce, když bude obrázek pro každou buňku jiný.
To vše by se dalo využít s komentářem.

[cherralie]

Bude to více obrázků, pro každou buňku jiný, ale tak max. do 20 obrázků.

[d1amond]

Dobra. Ale pokud nebude nekde napsano, jaky obrazek do jake bunky, tak musis mit 20x makro. 1 makro k jednomu obrazku. K veceru sem dam nejaky kod.

[cherralie]

ok, dekuji moc

[d1amond]

Kód: Vybrat vše

Sub ImgAsComment1()

For Each cell In Selection 'libovolny vyber bunek a oblasti

    ThisPicture = "C:\Documents and Settings\All Users\Dokumenty\Obrázky\Ukázky obrázků\lekníny.jpg" 'cesta k obrazku na disku
   
    With cell.AddComment
        .Shape.Fill.UserPicture ThisPicture
    End With
   
Next cell

End Sub

Makro po spuštění přidá komentář k vybrané buňce (nebo oblasti buněk), který má jako pozadí obrázek. Cestu k obrázku si nastav dle svého. Jak jsem psal, pro každý obrázek jedno makro (s jinou cestou).

[cherralie]

Bezvadný, děkuji mnohokrát, budu mít plusové body u šéfky :-)
Lucie

[mike007]

Já si dovolím ještě d1amondovo makro trochu vylepšit - v původním makru se musela cesta k obrázku nastavovat ručně což nebylo zrovna moc praktické.

Toto makro tedy stačí pouze spustit, na disku najít obrázek a je hotovo.

Kód: Vybrat vše

Sub ImgAsComment1()
For Each cell In Selection 'libovolny vyber bunek a oblasti
obrazek = Application.GetOpenFilename(FileFilter:="JPEG (*.jpg), *.jpg", Title:="Vyber obrázek")
ThisPicture = obrazek
With cell.AddComment
.Shape.Fill.UserPicture ThisPicture
End With
Next cell
End Sub

[cherralie]

Jste šikovní kluci, díky. L.