Error setting menu control's OnAction property

andrewafresh · February 3rd, 2009, 01:26 PM

Hello, I'm having a problem with some code in my personal.xls which aims to create a menu to run macros which I've written.

I've used this code for a few months, but its suddenly started erroring on a line which sets the OnAction property of a menu control. The error is "Method 'OnAction' of object '_CommandBarButton' failed".

The macro I'm trying to set this button to is in the same module as the code which creates the menu. I've tried commenting the first menu control but it still happens on the next one. I don't remember making any changes that may have caused this to suddenly start erroring.

In case that helps the full sub is below:

Code:

Sub CreateAndrewMenu()
Dim MenuBar As CommandBar
Dim NewMenu As CommandBarPopup
Dim NewControl As CommandBarControl
Const strMenuName As String = "Worksheet Menu Bar"
Set MenuBar = CommandBars(strMenuName)
Dim NoOfControls As Byte
Dim EachControl As Byte
Dim blnFound As Boolean
Dim NameOfSub As String
Dim strToolTip As String
Dim strCaption As String
 

'iterate the menus on Worksheet Menu Bar to see if Andrew menu exists:
NoOfControls = MenuBar.Controls.Count
For EachControl = 1 To NoOfControls
   If MenuBar.Controls.Item(EachControl).Caption = "&Andrew" Then blnFound = True
Next EachControl
 

'If the Andrew menu exists, delete it so we can start again - in case its corrupt
If blnFound Then
   MenuBar.Controls("Andrew").Delete
End If
 

'add Andrew menu to Worksheet Menu Bar:
Set NewMenu = MenuBar.Controls.Add(Type:=msoControlPopup)
With NewMenu
   .Caption = "&Andrew"
   .Visible = True
   .Enabled = True
End With
 

'Add sub DefaultTableFormat:
NameOfSub = "DefaultTableFormat"
strCaption = "Default &table format"
strToolTip = "Convert data to default table format"
GoSub CheckThatItemExists
 

'Add sub SentenceCase:
NameOfSub = "SentenceCase"
strCaption = "Change to &sentence case"
strToolTip = "Change the selection to sentence case"
GoSub CheckThatItemExists
 

'Add sub CopyFormula:
NameOfSub = "CopyFormula"
strCaption = "Copy formula"
strToolTip = "Copy formula of current cell without adjusting references"
GoSub CheckThatItemExists
 

TidyUp:
   On Error Resume Next
   Set MenuBar = Nothing
   Set NewMenu = Nothing
   Set NewControl = Nothing
   Exit Sub


ErrorCode:
   If Err.Number = -2147467259 Then
       'possibly cos in a protected book - no action
   Else
       ShowErrorMessage Err.Number, Err.Description
   End If
   Resume TidyUp
 

CheckThatItemExists:
   'iterate the options on the Andrew menu to see if NameOfSub is accessed from the menu:
   blnFound = False
   NoOfControls = NewMenu.Controls.Count
   For EachControl = 1 To NoOfControls
       If InStr(NewMenu.Controls.Item(EachControl).OnAction, NameOfSub) > 0 Then blnFound = True
   Next EachControl
   If Not (blnFound) Then 'add this sub as a new control:
       Set NewControl = NewMenu.Controls.Add(Type:=msoControlButton)
       With NewControl
           .Caption = strCaption
           .OnAction = NameOfSub 'THIS LINE NOW ERRORS
           .Style = msoButtonCaption
           .TooltipText = strToolTip
       End With
   End If
   Return


End Sub