P
Pred
I have my own CommandBar wich is composed of different FaceIDs. By clicking
on the FaceID, it starts my own procedure.
How could I create a sub menu with buttons only. The buttons would be
FaceIDs.
I would like that it works like the "Borders" icon in the Excel "Formatting"
CommandBar.
Here is what I tried without success.
Sub SetMyCmdBar()
Dim CmdBar
Dim Btn As CommandBarButton
Dim Fld As CommandBarControl
Dim BtnPopup As CommandBarControl
Dim BtnItem As CommandBarControl
Dim ArrCaption As Variant
Dim ArrFaceID As Variant
Dim ArrOnAction As Variant
Dim ArrToolTipText As Variant
Dim i As Integer
Application.ScreenUpdating = False
On Error Resume Next
Application.CommandBars("MyCommandBar").Delete
On Error GoTo 0
Set CmdBar = Application.CommandBars.Add
With CmdBar
.Name = "MyCommandBar"
.Visible = True
.Position = msoBarTop
'I have several buttons like the following
Set Btn = .Controls.Add 'MailThisFile
With Btn
.Style = msoButtonIconAndCaption
.FaceId = 258
.Width = 20
.OnAction = "MailThisFile"
.TooltipText = "Mail this file (Lotus Notes)"
.BeginGroup = True
.Tag = "MyBtn"
End With
ArrCaption = Array("Top", "Middle", "Bottom")
ArrFaceID = Array(2061, 2062, 2063)
ArrOnAction = Array("TopVertical", "MiddleVertical", "BottomVertical")
ArrToolTipText = Array("Align Selection on Top", "Align Selection on
Middle", "Align Selection on Bottom")
Set BtnPopup = .Controls.Add(Type:=msoControlPopup)
With BtnPopup
'.Caption = "Vertical Alignment"
.FaceId = 2068
.Tag = "MyBtn"
For i = 0 To 2
Set BtnItem = .Controls.Add
With BtnItem
'.Caption = ArrCaption(i)
.Style = msoButtonIconAndCaption
.FaceId = ArrFaceID(i)
.Width = 20
.OnAction = ArrOnAction(i)
.TooltipText = ArrToolTipText(i)
.Tag = "MyBtn"
End With
Next i
End With 'BtnPopup
End With 'CmdBar
on the FaceID, it starts my own procedure.
How could I create a sub menu with buttons only. The buttons would be
FaceIDs.
I would like that it works like the "Borders" icon in the Excel "Formatting"
CommandBar.
Here is what I tried without success.
Sub SetMyCmdBar()
Dim CmdBar
Dim Btn As CommandBarButton
Dim Fld As CommandBarControl
Dim BtnPopup As CommandBarControl
Dim BtnItem As CommandBarControl
Dim ArrCaption As Variant
Dim ArrFaceID As Variant
Dim ArrOnAction As Variant
Dim ArrToolTipText As Variant
Dim i As Integer
Application.ScreenUpdating = False
On Error Resume Next
Application.CommandBars("MyCommandBar").Delete
On Error GoTo 0
Set CmdBar = Application.CommandBars.Add
With CmdBar
.Name = "MyCommandBar"
.Visible = True
.Position = msoBarTop
'I have several buttons like the following
Set Btn = .Controls.Add 'MailThisFile
With Btn
.Style = msoButtonIconAndCaption
.FaceId = 258
.Width = 20
.OnAction = "MailThisFile"
.TooltipText = "Mail this file (Lotus Notes)"
.BeginGroup = True
.Tag = "MyBtn"
End With
ArrCaption = Array("Top", "Middle", "Bottom")
ArrFaceID = Array(2061, 2062, 2063)
ArrOnAction = Array("TopVertical", "MiddleVertical", "BottomVertical")
ArrToolTipText = Array("Align Selection on Top", "Align Selection on
Middle", "Align Selection on Bottom")
Set BtnPopup = .Controls.Add(Type:=msoControlPopup)
With BtnPopup
'.Caption = "Vertical Alignment"
.FaceId = 2068
.Tag = "MyBtn"
For i = 0 To 2
Set BtnItem = .Controls.Add
With BtnItem
'.Caption = ArrCaption(i)
.Style = msoButtonIconAndCaption
.FaceId = ArrFaceID(i)
.Width = 20
.OnAction = ArrOnAction(i)
.TooltipText = ArrToolTipText(i)
.Tag = "MyBtn"
End With
Next i
End With 'BtnPopup
End With 'CmdBar