Bild in aktive Zelle einfügen
18.06.2013 15:41:23
Albert
ich verwende folgenden Code, um ein Bild entweder im Hochformat bzw. im Querformat einzufügen.
Was allerdings nicht funktioniert ist die Position.
Vielleicht wisst ihr eine Lösung?
Option Explicit
Dim Bild As Variant
Private Sub Ok_Click()
Dim Location As Integer
Location = ActiveCell.Select
Bild = Application.GetOpenFilename("C:\,*.jpg")
If Bild 0 Then
On Error GoTo fehlerbehandlung
ActiveSheet.Pictures.Insert (Bild)
'On Error GoTo 0
If FileLen(Bild) / 1024 > 500 Then
MsgBox ("Die Bilddateigröße übersteigt die 200kb Größe! Bitte reduzieren sie erst die _
Dateigröße!")
Exit Sub
Else
If querformat.Value = True Then
If TypeName(Selection) = "Picture" Or TypeName(Selection) = "Grafik" Then 'nur _
wenn Grafik markiert ist :
With Selection.ShapeRange(Location)
.LockAspectRatio = True
'Breite und Höhe der Grafik bitte in Klammer hier anpassen :
'.Height = Application.CentimetersToPoints(6.77)
.Top = Selection.Top
.Left = Selection.Left
.Width = Application.CentimetersToPoints(9)
End With
End If
End If
If hochformat.Value = 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 :
'.Height = Application.CentimetersToPoints(9)
.Top = Selection.Top
.Left = Selection.Left
.Width = Application.CentimetersToPoints(7.25)
End With
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
A.