Bild importieren und anpassen

Sub sLoadPicture()
Dim fd                  As FileDialog
Dim FileChosen          As Integer
Dim pct                 As Picture
Dim iLeft, iTop, iWidth, iHeight
Dim sFile               As String
Dim dTempH              As Double
Dim dTempB              As Double
Dim rZelle              As String
Dim objPicture          As Object
If ActiveSheet.CodeName  "tblBilder" Then Exit Sub
rZelle = ActiveCell.Address
iLeft = tblBilder.Range(rZelle).Left
iTop = tblBilder.Range(rZelle).Top
iHeight = tblBilder.Range(rZelle).Height
Set fd = Application.FileDialog(msoFileDialogFilePicker)
FileChosen = fd.Show
fd.title = "Bild zum Import auswählen"
fd.InitialView = msoFileDialogViewSmallIcons
fd.Filters.Clear
If FileChosen = -1 Then
sFile = fd.SelectedItems(1)
If Right$(sFile, 4) = ".jpg" Or Right$(sFile, 4) = ".png" Or Right$(sFile, 5) = ".jpeg" Then
Set objPicture = tblBilder.Shapes.AddPicture _
( _
Filename:=sFile, _
Linktofile:=msoFalse, _
savewithdocument:=msoTrue, _
Left:=iLeft, _
Top:=iTop, _
Width:=-1, _
Height:=-1 _
)
objPicture.LockAspectRatio = msoTrue
objPicture.Height = iHeight
Set objPicture = Nothing
End If
End If
End Sub