Gruppe
Grafik
Problem
Über die erste Schaltfläche soll die Grafik mit dem in Zelle B1 stehenden Namen in die aktive Zelle eingefügt werden. Über die zweite Schaltfläche soll neu zentriert werden.
StandardModule: Modul1
Sub InsertPicture()
Dim pct As Picture
Dim iLeft, iTop, iWidth, iHeight
Dim sFile As String
sFile = Range("B1").Value
If Dir(sFile) = "" Then
Beep
MsgBox "Grafikdatei wurde nicht gefunden!"
Exit Sub
End If
With ActiveCell
iLeft = .Left
iTop = .Top
iWidth = .Width
iHeight = .Height
End With
Set pct = ActiveSheet.Pictures.Insert(Range("B1").Value)
pct.Left = iLeft + iWidth / 2 - pct.Width / 2
pct.Top = iTop + iHeight / 2 - pct.Height / 2
End Sub
Sub CenterPicture()
Dim pct As Picture
Dim iLeft, iTop, iWidth, iHeight
If ActiveSheet.Pictures.Count = 0 Then
Beep
MsgBox "Keine Grafikdatei gefunden!"
Exit Sub
End If
With ActiveCell
iLeft = .Left
iTop = .Top
iWidth = .Width
iHeight = .Height
End With
Set pct = ActiveSheet.Pictures(1)
pct.Left = iLeft + iWidth / 2 - pct.Width / 2
pct.Top = iTop + iHeight / 2 - pct.Height / 2
End Sub