"OnAction" problem

Hi,

I have been trying to get the following piece of code to work (it's part of a much larger sub from the MS KB) that calls on a function AddRemoveButton but when I perform the action I get the message "The macro cannot be found or has been disabled because of your security settings" (security is set at "low")

Code:

---

        With CBarCtl
            .Caption = "Drop Down"
            .Width = 100
            .AddItem "Create Button", 1
            .AddItem "Remove Button", 2
            .DropDownWidth = 100
            .OnAction = "=AddRemoveButton()"
        End With

---

I have tried:

Code:

---

.OnAction = "=AddRemoveButton()"
.OnAction = "AddRemoveButton()"
.OnAction = "AddRemoveButton"
.OnAction = AddRemoveButton

---

and still get the error message - any other suggestions anyone?

Thank you,
John :bink:

Hi John, how are ya? :)

I think you need to specify where you are getting the procedure from as it's source, maybe . . .

Code:

---

.OnAction = "Personal.xls!AddRemoveButton"

---

Although I'm not sure where the procedure is being held at this point ..

Do you have a public sub AddRemoveButton ??

I tried this to play around with it and it works:

Code:

---

Option Explicit

Sub test()
Dim CBarCtl As CommandBarButton
Set CBarCtl = Application.CommandBars("Standard").Controls("&Save")
With CBarCtl
'    .Caption = "Drop Down"
'    .Width = 100
'    .AddItem "Create Button", 1
'    .AddItem "Remove Button", 2
'    .DropDownWidth = 100
    .OnAction = "AddRemoveButton"
End With
End Sub

Sub AddRemoveButton()
MsgBox "hi"
End Sub

---

Quote:

---

Originally Posted by DRJ

Do you have a public sub AddRemoveButton ??

I tried this to play around with it and it works:

Code:

---

Option Explicit
 
Sub test()
Dim CBarCtl As CommandBarButton
Set CBarCtl = Application.CommandBars("Standard").Controls("&Save")
With CBarCtl
' .Caption = "Drop Down"
' .Width = 100
' .AddItem "Create Button", 1
' .AddItem "Remove Button", 2
' .DropDownWidth = 100
.OnAction = "AddRemoveButton"
End With
End Sub
 
Sub AddRemoveButton()
MsgBox "hi"
End Sub

---

---

No Jacob,
On their KB it was given as a function - but I'll try that.
This was given by them for use in Access, but it shood work just as well in Word or Excel. Will just have to play round some more.

What Zack sed sounds quite logical also - will try that also.

Thanx Zack, yeh, been pretty good, urself? It's just getn into summer down here in Oz (30 degrees C lately) and my A/C expired cupla days ago....makes it hard to sleep

John :bink:

This works as a function as well. Maybe if you post some more of the code or an attachment we can see what the problem is.

Code:

---

Option Explicit
 
Sub test()
Dim CBarCtl As CommandBarButton
    Set CBarCtl = Application.CommandBars("Standard").Controls("&Save")
    With CBarCtl
        '    .Caption = "Drop Down"
        '    .Width = 100
        '    .AddItem "Create Button", 1
        '    .AddItem "Remove Button", 2
        '    .DropDownWidth = 100
        .OnAction = "AddRemoveButton"
    End With
End Sub
 
Function AddRemoveButton()
MsgBox "hi"
End Function

---

[QUOTE=DRJ]This works as a function as well. Maybe if you post some more of the code or an attachment we can see what the problem is.

OK, here's the whole lot, exactly as copied from the MS KB... :bink:

Code:

---

' This procedure creates a new toolbar.
Sub AddNewCB()
Dim CBar As CommandBar, CBarCtl As CommandBarControl
On Error GoTo AddNewCB_Err
' Create a new floating toolbar and make it visible.
Set CBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
msoBarFloating)
CBar.Visible = True
' Create a button with text on the bar and set some properties.
Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
With CBarCtl
    .Caption = "Button"
    .Style = msoButtonCaption
    .TooltipText = "Display Message Box"
    .OnAction = "=MsgBox(""You pressed a toolbar button!"")"
End With
' Create a button with an image on the bar and set some
' properties.
Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
With CBarCtl
    .FaceId = 1000
    .Caption = "Toggle Button"
    .TooltipText = "Toggle First Button"
    .OnAction = "=ToggleButton()"
End With
' Create a combo box control on the bar and set some properties.
Set CBarCtl = CBar.Controls.Add(msoControlComboBox)
With CBarCtl
    .Caption = "Drop Down"
    .Width = 100
    .AddItem "Create Button", 1
.AddItem "Remove Button", 2
    .DropDownWidth = 100
    .OnAction = "=AddRemoveButton()"
End With
Exit Sub
AddNewCB_Err:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Sub
End Sub

---

'This procedure is called from a button on the toolbar.
It toggles the Visible property of another button on the bar.

Code:

---

Function ToggleButton()
Dim CBButton As CommandBarControl
On Error GoTo ToggleButton_Err
Set CBButton = CommandBars("Sample Toolbar").Controls(1)
CBButton.Visible = Not CBButton.Visible
Exit Function
ToggleButton_Err:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Function
End Function

---

This procedure is called from a combo box on the toolbar
It adds a button to the bar or removes it

Code:

---

Function AddRemoveButton()
Dim CBar As CommandBar, CBCombo As CommandBarComboBox
Dim CBNewButton As CommandBarButton
On Error GoTo AddRemoveButton_Err
Set CBar = CommandBars("Sample Toolbar")
Set CBCombo = CBar.Controls(3)
Select Case CBCombo.ListIndex
    'If Create Button is selected, create a button on the bar
    Case 1
        Set CBNewButton = CBar.Controls.Add(Type:=msoControlButton)
        With CBNewButton
            .Caption = "New Button"
            .Style = msoButtonCaption
            .BeginGroup = True
            .Tag = "New Button"
            .OnAction = "=MsgBox(""This is a new button!"")"
        End With
    ' Find and remove the new button if it exists.
    Case 2
        Set CBNewButton = CBar.FindControl(Tag:="New Button")
        CBNewButton.Delete
End Select
Exit Function
AddRemoveButton_Err:
' If the button does not exist.
    If Err.Number = 91 Then
        MsgBox "Cannot remove button that does not exist!"
        Exit Function
    Else
        MsgBox "Error " & Err.Number & vbCr & Err.Description
        Exit Function
    End If
End Function

---

Quote:

---

Originally Posted by DRJ

This works as a function as well. Maybe if you post some more of the code or an attachment we can see what the problem is.

Code:

---

Option Explicit
 
Sub test()
Dim CBarCtl As CommandBarButton
Set CBarCtl = Application.CommandBars("Standard").Controls("&Save")
With CBarCtl
    ' .Caption = "Drop Down"
    ' .Width = 100
    ' .AddItem "Create Button", 1
    ' .AddItem "Remove Button", 2
    ' .DropDownWidth = 100
    .OnAction = "AddRemoveButton"
End With
End Sub
 
Function AddRemoveButton()
MsgBox "hi"
End Function

---

---

PS I agree that this (above) works perfectly in both XL and Word, I just dont understand why the MS example doesn't.....

Try this one:

Code:

---

' This procedure creates a new toolbar.

Sub AddNewCB()
    Dim CBar As CommandBar, CBarCtl As CommandBarControl
    On Error GoTo AddNewCB_Err
    ' Create a new floating toolbar and make it visible.
    CommandBars("Sample Toolbar").Delete
    Set CBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
    msoBarFloating)
    CBar.Visible = True
    ' Create a button with text on the bar and set some properties.
    Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
    With CBarCtl
    .Caption = "Button"
    .Style = msoButtonCaption
    .TooltipText = "Display Message Box"
    .OnAction = "Message"
    End With
    ' Create a button with an image on the bar and set some
    ' properties.
    Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
    With CBarCtl
    .FaceId = 1000
    .Caption = "Toggle Button"
    .TooltipText = "Toggle First Button"
    .OnAction = "ToggleButton"
    End With
    ' Create a combo box control on the bar and set some properties.
    Set CBarCtl = CBar.Controls.Add(msoControlComboBox)
    With CBarCtl
    .Caption = "Drop Down"
    .Width = 100
    .AddItem "Create Button", 1
    .AddItem "Remove Button", 2
    .DropDownWidth = 100
    .OnAction = "AddRemoveButton"
    End With
    Exit Sub
AddNewCB_Err:
    MsgBox "Error " & Err.Number & vbCr & Err.Description
    Exit Sub
End Sub

---

This procedure is called from a button on the toolbar.
It toggles the Visible property of another button on the bar.

Code:

---

Function ToggleButton()
    Dim CBButton As CommandBarControl
    On Error GoTo ToggleButton_Err
    Set CBButton = CommandBars("Sample Toolbar").Controls(1)
    CBButton.Visible = Not CBButton.Visible
    Exit Function
ToggleButton_Err:
    MsgBox "Error " & Err.Number & vbCr & Err.Description
    Exit Function
End Function

---

This procedure is called from a combo box on the toolbar
It adds a button to the bar or removes it

Code:

---

Function AddRemoveButton()
    Dim CBar As CommandBar, CBCombo As CommandBarComboBox
    Dim CBNewButton As CommandBarButton
    On Error GoTo AddRemoveButton_Err
    Set CBar = CommandBars("Sample Toolbar")
    Set CBCombo = CBar.Controls(3)
    Select Case CBCombo.ListIndex
    'If Create Button is selected, create a button on the bar
    Case 1
        Set CBNewButton = CBar.Controls.Add(Type:=msoControlButton)
        With CBNewButton
            .Caption = "New Button"
            .Style = msoButtonCaption
            .BeginGroup = True
            .Tag = "New Button"
            .OnAction = "=MsgBox(""This is a new button!"")"
End With
        ' Find and remove the new button if it exists.
    Case 2
        Set CBNewButton = CBar.FindControl(Tag:="New Button")
        CBNewButton.Delete
End Select
    Exit Function
AddRemoveButton_Err:
    ' If the button does not exist.
    If Err.Number = 91 Then
    MsgBox "Cannot remove button that does not exist!"
    Exit Function
    Else
    MsgBox "Error " & Err.Number & vbCr & Err.Description
    Exit Function
    End If
End Function

Sub Message()
MsgBox "You pressed a toolbar button!"
End Sub

---

Thanx Jacob, :)

Sorry for the delay in replying, but my server went down... :mad:

At first I kept getting "Error 5 - invalid procedure call or argument" in XL with your mods, but NOT in Word - but there were other probs in Word and some really weird inconsistent results (like OnAction for the 1st button calling the external function before saving but not after and other OnActions not always working) that took a lotta fiddling to get rid of.

Now, as long as one removes all previous instances of it via View/Toolbars/delete/quit before running it, it then seems to give very consistent results in BOTH Word and Excel. :D

Although the original was intended for msAccess, turns out it's a pretty cool tool for your XL & Word "apps". Here is the further (v. small) mods I had to make to get it working properly if anyone's interested in testing or using it....

John :bink:

Edied: To re-include "CommandBars("Sample Toolbar").Delete" but with "On Error Resume Next" preceding it to preclude failure when there are no extant toolbars....

Code:

---

' This procedure creates a new toolbar.

Sub AddNewCB()
Dim CBar As CommandBar, CBarCtl As CommandBarControl
On Error GoTo AddNewCB_Err
' Create a new floating toolbar and make it visible.
On Error Resume Next '//EDIT (works better)
CommandBars("Sample Toolbar").Delete
Set CBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
msoBarFloating)
CBar.Visible = True
' Create a button with text on the bar and set some properties.
Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
With CBarCtl
    .Caption = "Button"
    .Style = msoButtonCaption
    .TooltipText = "Display Message Box"
    .OnAction = "Message"
End With
' Create a button with an image on the bar and set some
' properties.
Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
With CBarCtl
    .FaceId = 1000
    .Caption = "Toggle Button"
    .TooltipText = "Toggle First Button"
    .OnAction = "ToggleButton"
End With
' Create a combo box control on the bar and set some properties.
Set CBarCtl = CBar.Controls.Add(msoControlComboBox)
With CBarCtl
    .Caption = "Drop Down"
    .Width = 100
    .AddItem "Create Button", 1
    .AddItem "Remove Button", 2
    .DropDownWidth = 100
    .OnAction = "AddRemoveButton"
End With
Exit Sub
AddNewCB_Err:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Sub
End Sub

---

This procedure is called from a button on the toolbar.
It toggles the Visible property of another button on the bar.

Code:

---

Function ToggleButton()
Dim CBButton As CommandBarControl
On Error GoTo ToggleButton_Err
Set CBButton = CommandBars("Sample Toolbar").Controls(1)
CBButton.Visible = Not CBButton.Visible
Exit Function
ToggleButton_Err:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Function
End Function

---

This procedure is called from a combo box on the toolbar
It adds a button to the bar or removes it

Code:

---

Function AddRemoveButton()
Dim CBar As CommandBar, CBCombo As CommandBarComboBox
Dim CBNewButton As CommandBarButton
On Error GoTo AddRemoveButton_Err
Set CBar = CommandBars("Sample Toolbar")
Set CBCombo = CBar.Controls(3)
Select Case CBCombo.ListIndex
    'If Create Button is selected, create a button on the bar
    Case 1
        Set CBNewButton = CBar.Controls.Add(Type:=msoControlButton)
        With CBNewButton
            .Caption = "New Button"
            .Style = msoButtonCaption
            .BeginGroup = True
            .Tag = "New Button"
            .OnAction = MsgBox("There is a new button!")
        End With
    ' Find and remove the new button if it exists.
    Case 2
        Set CBNewButton = CBar.FindControl(Tag:="New Button")
        CBNewButton.Delete
        MsgBox ("Button deleted!")
End Select
Exit Function
AddRemoveButton_Err:
' If the button does not exist.
If Err.Number = 91 Then
    MsgBox "Cannot remove button that does not exist!"
    Exit Function
Else
    MsgBox "Error " & Err.Number & vbCr & Err.Description
    Exit Function
End If
End Function
 
Function Message()
MsgBox "You pressed a toolbar button!"
End Function

---

You're Welcome

Take Care

This is straying from the original problem, but I been thinking about this (Ohhh trouble - John's been 'thinking')... :p

Some will no doubt disagree, but personally, I think the small added procedure below would be a far more sensible procedure than the one given in the MS KB example above... :rolleyes:

E.G. A user may have one of these command bars that they have taken the trouble to create many buttons for and then re-named them & assigned links to all of them - but the command bar may be hidden and the user may have forgotten they've hidden it and thinks "Damn! I'll have to start all over..."

So, instead of blindly deleting & creating a command bar that may already exist but is hidden from view, wouldn't this be more logical? - if they dont already have one THEN, and only then, make one - otherwise, just unhide it. (Example below)

If for any reason they really want to delete their modified one and make a new one, they can do that manually by going to view/toolbars/delete... (a message with this advice could also be added) :bink:

Code:

---

' If it already exists. This procedure makes the toolbar visible.

 Sub AddNewCB()
      Dim CBar As CommandBar, Count As Integer
      Count = 0
      For Each CBar In CommandBars
      If CBar.Name = "Sample Toolbar" Then Count = Count + 1
      Next CBar
      If Count = 0 Then MakeNewCB
If Count > 1 Then MsgBox ("ERROR! There are " & Count & " toolbars - Delete " & Count - 1 & " !") Else
On Error Resume Next
CommandBars("Sample Toolbar").Visible = True
 End Sub

---

This procedure creates a new toolbar.

Code:

---

Function MakeNewCB() '
    Dim CBar As CommandBar, CBarCtl As CommandBarControl
    ' Create a new floating toolbar and make it visible.
    On Error Resume Next
    Set CBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
    msoBarFloating)
    CBar.Visible = True
    ' Create a button with text on the bar and set some properties.
    Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
    With CBarCtl
    .Caption = "Button"
    .Style = msoButtonCaption
    .TooltipText = "Display Message Box"
    .OnAction = "Message"
    End With
    ' Create a button with an image on the bar and set some
    ' properties.
    Set CBarCtl = CBar.Controls.Add(Type:=msoControlButton)
    With CBarCtl
    .FaceId = 1000
    .Caption = "Toggle Button"
    .TooltipText = "Toggle First Button"
    .OnAction = "ToggleButton"
    End With
    ' Create a combo box control on the bar and set some properties.
    Set CBarCtl = CBar.Controls.Add(msoControlComboBox)
    With CBarCtl
    .Caption = "Drop Down"
    .Width = 100
    .AddItem "Create Button", 1
    .AddItem "Remove Button", 2
    .DropDownWidth = 100
        .OnAction = "AddRemoveButton"
    End With
End Function

---

This procedure is called from a button on the toolbar.
It toggles the Visible property of another button on the bar.

Code:

---

Function ToggleButton()
    Dim CBButton As CommandBarControl
    On Error GoTo ToggleButton_Err
    Set CBButton = CommandBars("Sample Toolbar").Controls(1)
    CBButton.Visible = Not CBButton.Visible
    Exit Function
ToggleButton_Err:
    MsgBox "Error " & Err.Number & vbCr & Err.Description
    Exit Function
End Function

---

This procedure is called from a combo box on the toolbar
It adds a button to the bar or removes it

Code:

---

Function AddRemoveButton()
    Dim CBar As CommandBar, CBCombo As CommandBarComboBox
    Dim CBNewButton As CommandBarButton
    On Error GoTo AddRemoveButton_Err
    Set CBar = CommandBars("Sample Toolbar")
    Set CBCombo = CBar.Controls(3)
    Select Case CBCombo.ListIndex
    'If Create Button is selected, create a button on the bar
    Case 1
        Set CBNewButton = CBar.Controls.Add(Type:=msoControlButton)
        With CBNewButton
            .Caption = "New Button"
            .Style = msoButtonCaption
            .BeginGroup = True
            .Tag = "New Button"
            .OnAction = MsgBox("There is a new button!")
        End With
    ' Find and remove the new button if it exists.
    Case 2
        Set CBNewButton = CBar.FindControl(Tag:="New Button")
        CBNewButton.Delete
        MsgBox ("Button deleted!")
    End Select
    Exit Function
AddRemoveButton_Err:
    ' If the button does not exist.
    If Err.Number = 91 Then
    MsgBox "Cannot remove button that does not exist!"
    Exit Function
    Else
    MsgBox "Error " & Err.Number & vbCr & Err.Description
    Exit Function
    End If
End Function
 
Function Message()
    MsgBox "You pressed a toolbar button!"
End Function

---