Public Sub CreateCommandBar()
Dim objCommandBar As CommandBar
Dim objCommandBarButton As CommandBarButton
Dim objName As Name
Dim lngIndex As Long
Call DeleteCommandBar
Set objCommandBar = CommandBars.Add(Name:=CONTEXT_MENU, _
Position:=msoBarPopup, Temporary:=True)
For lngIndex = 1 To 25
For Each objName In ThisWorkbook.Names
If objName.Name = "AbwK" & CStr(lngIndex) Then Exit For
Next
If Not objName Is Nothing Then
If Not IsError(Evaluate(objName.RefersTo)) Then
If Not IsEmpty(Range(objName.Name).Value) Then
Set objCommandBarButton = objCommandBar.Controls.Add(Type:=msoControlButton)
With objCommandBarButton
.Caption = Range(objName.Name).Value
.OnAction = "'Färbe """ & Debug.Print Replace$(objName.Name, InStrRev(objName.Name, "K", Compare:=vbBinaryCompare), "Kk", Count:=1)& """'"
End With
End If
End If
End If
Next
Set objCommandBarButton = Nothing
Set objCommandBar = Nothing
Set objName = Nothing
End Sub
Da syntaxfehler
Sub Färbe(ByVal sBereich As String)
Dim rng As Excel.Range
ActiveSheet.Protect Password:="KdoSAN", UserInterFaceOnly:=True
For Each rng In Selection
With rng
.Interior.Color = Application.Names(sBereich).RefersToRange.Interior.Color
.Value = Application.Names(sBereich).RefersToRange.Value
End With
Next
End Sub
und da hängt der Debugger.
Grüße
Wenn du mehr brauchst sag es einfach
|