Gruppe
Ereignis
Problem
Bei Eingaben in Zelle B1 soll die dort genannte Grafikdatei in alle Tabellen unter Hinzufügen einer Makrozuweisung eingefügt werden. Bestehende Grafiken sind zu löschen.
ClassModule: Tabelle1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPic As Picture
Dim iWks As Integer
Dim sFile As String
If Target.Address <> "$B$1" Then Exit Sub
If IsEmpty(Target) Then Exit Sub
sFile = Range("B1").Value
If Dir(sFile) = "" Then
Beep
MsgBox "Grafikdatei wurde nicht gefunden!"
Exit Sub
End If
Call DeleteShapes
For iWks = Me.Index To Worksheets.Count
Set oPic = Worksheets(iWks).Pictures.Insert(sFile)
With oPic
.Left = 100
.Top = 120
.Width = 80
.Height = 120
.OnAction = "GoToWks"
End With
Next iWks
End Sub
StandardModule: Modul1
Sub DeleteShapes()
Dim wks As Worksheet
For Each wks In Worksheets
wks.Pictures.Delete
Next wks
End Sub
Sub GoToWks()
Worksheets(Range("B2").Value).Select
End Sub