Gruppe
Ereignis
Bereich
Change
Thema
Bei Eingabe Grafiken in alle Tabellen und Makro zuweisen
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.
Lösung
Geben Sie den Ereigniscode in das Klassenmodul des Arbeitsblattes ein.
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