|
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strPath$, strFileName$, ar&()
If Target.Count > 1 Then Exit Sub
If Target.Column <> 4 Then Exit Sub
If Target.Row < 3 Then Exit Sub
strPath = ThisWorkbook.Path & "\"
strFileName = strPath & Target.Offset(, -2).Value & "\" & Target.Offset(, -1).Value & ".jpg"
If Dir(strFileName) <> "" Then
Cells.ClearComments
With Target
ar = GetPic(strFileName)
.AddComment
With .Comment
.Visible = True
.Shape.Fill.UserPicture strFileName
.Text Text:=" "
.Shape.Height = ar(0): .Shape.Width = ar(1)
End With
End With
End If
End Sub
Function GetPic(ByVal strFileName$) As Long()
Dim ar&(1)
Dim Img As Object
With CreateObject("WIA.ImageFile")
.LoadFile strFileName
ar(0) = .Height: ar(1) = .Width
End With
GetPic = ar
End Function
|
|