AW: wie fügst du den die Shapes ein? o.T.
23.02.2010 14:58:02
Josef
Hallo Gregor,
als erstes solltest du mal deine Variablen deklarieren und auch gleich den richtigenTyp verwenden.
Wie ich es sehe, gibst du den Shapoes beim Einfügen einen namen mit, den kann man doch zum Löschen auch verwenden.
Ungetestet!
Sub Var1()
Dim objShTarget As Worksheet, objShSource As Worksheet
Dim rng As Range
Dim Wert As String, Hyperlink As String
Dim lngLast As Long
On Error GoTo ErrExit
Application.ScreenUpdating = False
Application.EnableEvents = False
Set objShSource = Sheets("Tabelle1")
Set objShTarget = Sheets("Tabelle2")
With objShTarget
Spalte_Abkürzung = .Rows(1).Find("Abkürzung", LookAt:=xlWhole).Column
lngLast = objShSource.Cells(Rows.Count, 1).End(xlUp).Row
.Activate
For Start = 1 To lngLast
Wert = objShSource.Cells(Start, 1).Value
Hyperlink = objShSource.Cells(Start, 2).Value
Set rng = .Range("A:A").Find(Wert, LookAt:=xlWhole)
If Not rng Is Nothing Then
Abkürzung = .Cells(rng.Row, Spalte_Abkürzung).Value
On Error Resume Next
.Shapes("Objekt" & Abkürzung).Delete
On Error GoTo ErrExit
End If
.Shapes("Objekt").Copy
.Cells(rng.Row, 4).Select
.Paste
Selection.Name = "Objekt" & Abkürzung
.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=Hyperlink
Next
End With
ErrExit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Set objShSource = Nothing
Set objShTarget = Nothing
End Sub
Gruß Sepp