B
Brian J. Matuschak
Greetings:
I've inherited an Excel application that I need to debug. One of the
remaining things I need to fix is showing tooltips in a custom popup menu. I
have "Show ScreenTips on toolbars" enabled under the "Customize" dialog, but
it isn't as simple as that. Here are the subs that populate the menus:
' Calling procedure
Public Sub PopupMenuAddStaffing()
Dim cbar As CommandBar
Dim ctrl As CommandBarControl
Dim ctrlCut As CommandBarControl
Dim sx As String
Dim iReset As Integer
Dim sTool As String
Dim idx As Integer
On Error GoTo eh
' ---
Call goMenu.PopupMenuDeleteStaffing
Call InsertMainMenuBar
With Application.CommandBars("Cell")
On Error Resume Next
' put a separator bar before the 'Cut' item
iReset = ResetWorkbookExists()
If iReset = 0 Then
.Controls(1).BeginGroup = True ' put a spacer between our menu
and the existing
Else
.Controls(1).BeginGroup = False
End If
End With
' item: SlideCalendar
sTool = "Delete first 7 days and fill to 90 days"
MenuItemAdd CAPSLIDECALENDAR, sTool, 2143, "SlideCalendar", 1, False
MenuSubItemAdd CAPSLIDECALENDAR, sTool, 2143, "SlideCalendar", 1, False
' item: ResetWorkbook
sTool = "Reset staff assignments from Events sheet"
If iReset = 0 Then MenuItemAdd CAPRESETWORKBOOK, sTool, 1709,
"ResetWorkbook", 1, False
MenuSubItemAdd CAPRESETWORKBOOK, sTool, 1709, "ResetWorkbook", 1, False
' item: Print Setup
sTool = "Setup Print Output Sheet"
MenuItemAdd CAPPRINT, sTool, 707, "PrintSheet", 1, False
MenuSubItemAdd CAPPRINT, sTool, 707, "PrintSheet", 1, False
' item: SortEvents
sTool = "Sort Event Rows"
MenuItemAdd CAPSORTEVENTS, sTool, 2170, "SortEvents", 1, False
MenuSubItemAdd CAPSORTEVENTS, sTool, 2170, "SortEvents", 1, False
' item: AddEvent locally
sTool = "Add a new event to this spreadsheet only"
MenuItemAdd CAPADDEVENTLOC, sTool, 2114, "ManualAddEvent", 1, False
MenuSubItemAdd CAPADDEVENT, sTool, 2114, "AddEvent", 1, False
' item: AddEvent
sTool = "Add a new event to EventCal"
MenuItemAdd CAPADDEVENT, sTool, 2114, "AddEvent", 1, True
MenuSubItemAdd CAPADDEVENT, sTool, 2114, "AddEvent", 1, True
' item: Assignment Sheet
' Modified by Brian Matuschak 11/16/05
sTool = "Assign Resources to Event and use to unhide the Assignment sheet"
MenuItemAdd CAPASSIGNSHEET, sTool, 2104, "ShowAssignSheet", 1, False
MenuSubItemAdd CAPASSIGNSHEET, sTool, 2104, "ShowAssignSheet", 1, False
' item: Assign resources
sTool = "Assign Resources to Event"
MenuItemAdd CAPASSIGNRESOURCES, sTool, 1084, "ShowAssignForm", 1, False
MenuSubItemAdd CAPASSIGNRESOURCES, sTool, 1084, "ShowAssignForm", 1, False
' ---
GoTo xt
eh: oEH.PostErr Err, msMODULE, "PopupMenuAddStaffing", Erl
xt: 'PopupMenuAddStaffing
Set ctrl = Nothing
Set cbar = Nothing
End Sub
' Sub to populate the menus with similar code for submenu items
Private Sub MenuItemAdd(sCaption As String, sTool As String, iFace As
Integer, sAction As String, iBefore As Integer, bBeginGroup As Boolean)
With Application.CommandBars("Cell")
With .Controls.Add(msoControlButton, 1, , iBefore, True)
.Caption = sCaption
.TooltipText = sTool
.FaceId = iFace
.OnAction = sAction
.BeginGroup = bBeginGroup
End With
End With
End Sub
Well, I get all my commands and icons to work. Any suggestions about why the
tooltips might not be working?
I've inherited an Excel application that I need to debug. One of the
remaining things I need to fix is showing tooltips in a custom popup menu. I
have "Show ScreenTips on toolbars" enabled under the "Customize" dialog, but
it isn't as simple as that. Here are the subs that populate the menus:
' Calling procedure
Public Sub PopupMenuAddStaffing()
Dim cbar As CommandBar
Dim ctrl As CommandBarControl
Dim ctrlCut As CommandBarControl
Dim sx As String
Dim iReset As Integer
Dim sTool As String
Dim idx As Integer
On Error GoTo eh
' ---
Call goMenu.PopupMenuDeleteStaffing
Call InsertMainMenuBar
With Application.CommandBars("Cell")
On Error Resume Next
' put a separator bar before the 'Cut' item
iReset = ResetWorkbookExists()
If iReset = 0 Then
.Controls(1).BeginGroup = True ' put a spacer between our menu
and the existing
Else
.Controls(1).BeginGroup = False
End If
End With
' item: SlideCalendar
sTool = "Delete first 7 days and fill to 90 days"
MenuItemAdd CAPSLIDECALENDAR, sTool, 2143, "SlideCalendar", 1, False
MenuSubItemAdd CAPSLIDECALENDAR, sTool, 2143, "SlideCalendar", 1, False
' item: ResetWorkbook
sTool = "Reset staff assignments from Events sheet"
If iReset = 0 Then MenuItemAdd CAPRESETWORKBOOK, sTool, 1709,
"ResetWorkbook", 1, False
MenuSubItemAdd CAPRESETWORKBOOK, sTool, 1709, "ResetWorkbook", 1, False
' item: Print Setup
sTool = "Setup Print Output Sheet"
MenuItemAdd CAPPRINT, sTool, 707, "PrintSheet", 1, False
MenuSubItemAdd CAPPRINT, sTool, 707, "PrintSheet", 1, False
' item: SortEvents
sTool = "Sort Event Rows"
MenuItemAdd CAPSORTEVENTS, sTool, 2170, "SortEvents", 1, False
MenuSubItemAdd CAPSORTEVENTS, sTool, 2170, "SortEvents", 1, False
' item: AddEvent locally
sTool = "Add a new event to this spreadsheet only"
MenuItemAdd CAPADDEVENTLOC, sTool, 2114, "ManualAddEvent", 1, False
MenuSubItemAdd CAPADDEVENT, sTool, 2114, "AddEvent", 1, False
' item: AddEvent
sTool = "Add a new event to EventCal"
MenuItemAdd CAPADDEVENT, sTool, 2114, "AddEvent", 1, True
MenuSubItemAdd CAPADDEVENT, sTool, 2114, "AddEvent", 1, True
' item: Assignment Sheet
' Modified by Brian Matuschak 11/16/05
sTool = "Assign Resources to Event and use to unhide the Assignment sheet"
MenuItemAdd CAPASSIGNSHEET, sTool, 2104, "ShowAssignSheet", 1, False
MenuSubItemAdd CAPASSIGNSHEET, sTool, 2104, "ShowAssignSheet", 1, False
' item: Assign resources
sTool = "Assign Resources to Event"
MenuItemAdd CAPASSIGNRESOURCES, sTool, 1084, "ShowAssignForm", 1, False
MenuSubItemAdd CAPASSIGNRESOURCES, sTool, 1084, "ShowAssignForm", 1, False
' ---
GoTo xt
eh: oEH.PostErr Err, msMODULE, "PopupMenuAddStaffing", Erl
xt: 'PopupMenuAddStaffing
Set ctrl = Nothing
Set cbar = Nothing
End Sub
' Sub to populate the menus with similar code for submenu items
Private Sub MenuItemAdd(sCaption As String, sTool As String, iFace As
Integer, sAction As String, iBefore As Integer, bBeginGroup As Boolean)
With Application.CommandBars("Cell")
With .Controls.Add(msoControlButton, 1, , iBefore, True)
.Caption = sCaption
.TooltipText = sTool
.FaceId = iFace
.OnAction = sAction
.BeginGroup = bBeginGroup
End With
End With
End Sub
Well, I get all my commands and icons to work. Any suggestions about why the
tooltips might not be working?