Asi tak, ze zapis provedu v A1 a komentar se vlozi do D1.
Diky vsem za radu.
Kód: Vybrat vše
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cmnt As Excel.Comment, DiskPath As String, Extsn As String
' je zmena v pozadovane oblasti bunek
If Intersect(Target, Me.Range("c4:c7")) Is Nothing Then Exit Sub
' redukce na jednu bunku (napr. pri mazani vice bunek)
Set Target = Target.Resize(1, 1)
' disk a cesta, rozsireni
DiskPath = "D:\Data\Excel\"
Extsn = ".bmp"
With Target
'odstrani pripadny komentar a vlozi novy
.ClearComments
' bunka je prazdna
If Target.Value = vbNullString Then Exit Sub
Set Cmnt = .AddComment
'vlozi obrazek podle nazvu v bunce
'a formatuje komentar
With Cmnt
On Error Resume Next
.Shape.Fill.UserPicture DiskPath & .Parent.Value & Extsn
' osetreni chyby pri odkazu na obrazek
If err.Number <> 0 Then
'*vyber si moznost odstranenim a pridanim apostrofu k prislusnemu radku, zde prvni moznost*
' bud bez vlozeni prazdneho komentare
Target.ClearComments: GoTo ErrHandler
' nebo vlozeny komentar se sdelenim
' .Text Text:="Obrazek nebyl nalezen"
'**********************************
End If
On Error GoTo 0
' nastavit rozmery komentare
.Shape.Height = 150 ' vyska
.Shape.Width = 150 ' sirka
' zobrazeni komentare pouze pri najeti kurzoru na bunku = False nebo trvale = True
.Visible = False ' True
End With
End With
ErrHandler:
Set Cmnt = Nothing
End Sub
