Private Sub RenameCheckBox2()
Dim rngNames As Excel.Range
Dim shp As Excel.Shape
Dim i As Long
On Error GoTo ErrHandler
Set rngNames = Worksheets("Lists").Range("R:R")
With Worksheets("Checklist Structure")
For Each shp In .Shapes
If shp.Type = msoFormControl Then
If shp.FormControlType = xlCheckBox Then
If i < rngNames.Cells.count Then
i = i + 1
Debug.Print Format$(i, "000") & ": " & shp.OLEFormat.Object.Name & " => " & rngNames.Cells(i).Value
shp.OLEFormat.Object.Name = rngNames.Cells(i).Value
Else
Exit For
End If
End If
End If
Next
End With
Exit Sub
ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Fehler " & Err.number)
End Sub