Bild hochformat/querformat

Private Sub Ok_Click()
Dim rngLocation As Range
Dim i As Integer
Dim shpBild As Shape
Set rngLocation = ActiveCell
Bild = Application.GetOpenFilename("C:\,*.jpg")
If Bild  0 Then
On Error GoTo fehlerbehandlung
ActiveSheet.Pictures.Insert(Bild).Select
'On Error GoTo 0
If FileLen(Bild) / 1024 > 500 Then
MsgBox ("Die Bilddateigröße übersteigt die 500kb Größe! Bitte reduzieren sie erst die  _
Dateigröße! ")
Exit Sub
Else
If querformat = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then 'nur  _
wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Top = rngLocation.Top + 32
.Left = rngLocation.Left + 8
.Height = Application.CentimetersToPoints(6.77)
.Width = Application.CentimetersToPoints(9)
End With
For Each shpBild In ActiveSheet.Shapes
If shpBild.Type = msoPicture Then
shpBild.Placement = xlFreeFloating
End If
Next
End If
End If
If hochformat = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then 'nur  _
wenn Grafik markiert ist :
With Selection.ShapeRange
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
.Top = rngLocation.Top + 10
.Left = rngLocation.Left + 30
.Height = Application.CentimetersToPoints(9)
.Width = Application.CentimetersToPoints(7.25)
End With
For Each shpBild In ActiveSheet.Shapes
If shpBild.Type = msoPicture Then
shpBild.Placement = xlFreeFloating
End If
Next
End If
End If
End If
End If
Exit Sub
fehlerbehandlung:
If Err.Number = 1004 Then MsgBox "Fehler beim Einfügen der Grafik!" _
& Chr(13) & Chr(13) & "Wahrscheinlich kein lesbares Grafikformat"
End Sub