Creates Excel menu on the fly, list of menu items, command actions, and icons need to be in format of ANStrList.
Icons to be passed are FaceIDs, Excel FaceIDs, get list of FaceIDs from http://Mydev.net/?DevID=J9GIMEFSG9
Tested in Excel 2016
Sub ExcelMenu_onfly(ANStrListCaptions, ANStrListFaceIDs, ANStrListCommands)
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
' Delete existing FaceIds toolbar if it exists
CMName = "CustomExcelMenu445511"
SepaCol = "{{$C$}}"
On Error Resume Next
Application.CommandBars(CMName).Delete
On Error GoTo 0
X1 = 0
With Application.CommandBars.Add(Name:=CMName, _
Position:=msoBarPopup, MenuBar:=False, temporary:=True)
For Each MenID In Split(ANStrListCaptions, SepaCol)
If MenID > "" Then
X1 = X1 + 1
With .Controls.Add(Type:=msoControlButton)
If i / 10 = Int(i / 10) Then .BeginGroup = True
.Caption = CutString3(ANStrListCaptions, X1, SepaCol) ' "FaceID = " & i
.FaceId = CutString3(ANStrListFaceIDs, X1, SepaCol) ' i '346
.OnAction = CutString3(ANStrListCommands, X1, SepaCol)
'.OnAction = "'" & ThisWorkbook.Name & "'!" & "ValidateRow"
End With
End If
Next
End With
Application.CommandBars(CMName).Width = 4500
Application.CommandBars(CMName).ShowPopup
End Sub
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
' Delete existing FaceIds toolbar if it exists
CMName = "CustomExcelMenu445511"
SepaCol = "{{$C$}}"
On Error Resume Next
Application.CommandBars(CMName).Delete
On Error GoTo 0
X1 = 0
With Application.CommandBars.Add(Name:=CMName, _
Position:=msoBarPopup, MenuBar:=False, temporary:=True)
For Each MenID In Split(ANStrListCaptions, SepaCol)
If MenID > "" Then
X1 = X1 + 1
With .Controls.Add(Type:=msoControlButton)
If i / 10 = Int(i / 10) Then .BeginGroup = True
.Caption = CutString3(ANStrListCaptions, X1, SepaCol) ' "FaceID = " & i
.FaceId = CutString3(ANStrListFaceIDs, X1, SepaCol) ' i '346
.OnAction = CutString3(ANStrListCommands, X1, SepaCol)
'.OnAction = "'" & ThisWorkbook.Name & "'!" & "ValidateRow"
End With
End If
Next
End With
Application.CommandBars(CMName).Width = 4500
Application.CommandBars(CMName).ShowPopup
End Sub
ANStrListCaptions, ANStrListFaceIDs, ANStrListCommands
ExcelMenu_onfly "Caption1{{$C$}}Caption2","44{{$C$}}55","Command1{{$C$}}Command2"
see screenshots
see screenshots
Views 3,656
Downloads 1,401
CodeID
DB ID