Public Sub ShapesAction()
Dim c As Long
Dim n As Long
Dim s As String
Dim v As String
Dim d As Collection
' Fehler abschalten...
On Error Resume Next
' Collection...
Set d = New Collection
' Einlesen der Werte...
With ThisWorkbook.Worksheets("Labels")
For n = 2 To 22
d.Add CStr(n), .Cells(n, 1).Value
Next
End With
' Shape...
s = Application.Caller
v = ActiveSheet.Shapes(s).TextFrame2.TextRange.Text
c = CLng(CStr(0) & d(s))
' Check...
If c > 0 Then
If Len(v) > 0 Then
ActiveSheet.Shapes(s).TextFrame2.TextRange.Text = ""
ThisWorkbook.Worksheets("Labels").Cells(c, 2).Value = 0
Else
ActiveSheet.Shapes(s).TextFrame2.TextRange.Text = "X"
ThisWorkbook.Worksheets("Labels").Cells(c, 2).Value = 1
End If
Else
MsgBox "Element nicht gefunden."
End If
' Collection...
Set d = Nothing
End Sub