Hallo Sepp
Dein Code funktioniert perfekt nur habe ich 1 Problem bei einem Rechner wo ich noch Excel 2003 habe. Dort bleibt er in der zeile hängen
Gibt es die Funktion unter Excel 2003 nicht oder habe ich irgentwo einen Fehler dirn?
Danke für eure Hilfe
Private Sub CommandButton3_Click()
Dim rng As Range, rngA As Range
Dim vntret As Variant
Set rngA = ActiveCell
For Each rng In Range("z20:z50")
vntret = Application.Match(rng, Sheets("Kantenbild").Range("c1:C30"), 0)
If IsNumeric(vntret) And rng "" Then
erasePic rng
copyPic rng.Offset(0, -4), CLng(vntret)
Else
erasePic rng
End If
Next
rngA.Select
End Sub
Private Sub erasePic(Target As Range)
Dim objPic As Shape
For Each objPic In Me.Shapes
If objPic.TopLeftCell.Row = Target.Row Then
objPic.Delete
Exit Sub
End If
Next
End Sub
Private Sub copyPic(Target As Range, Index As Long)
Dim objPic As Shape, objCopy As Shape
With Sheets("Kantenbild")
For Each objPic In .Shapes
If objPic.TopLeftCell.Row = Index Then
objPic.Copy
Me.Paste
Set objCopy = Me.Shapes(Me.Shapes.Count)
objCopy.Left = Target.Left
objCopy.Top = Target.Top
Exit Sub
End If
Next
End With
End Sub