Linksklick in Zelle Bild einfügen

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const FOLDER_PATH As String = "D:\EMDB\HTML\ExcelCovers\"
Dim strFilename As String
Dim objCell As Range
Dim objImage1 As Shape
For Each objCell In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
If objCell.Image1 Is Nothing Then
Set objImage1 = objCell.AddImage1
Else
Set objImage1 = objCell.Image1
End If
Call objImage1(Text:="", Start:=1)
strFilename = Dir$(FOLDER_PATH & objCell.Text & ".*")
If strFilename  vbNullString Then
With objImage1.Shape
Call .Fill.UserPicture(PictureFile:=FOLDER_PATH & strFilename)
.Width = 260
.Height = 323
End With
End If
Next
Set objImage1 = Nothing
End Sub