PDA

View Full Version : Solved: "OnAction" problem



johnske
10-03-2004, 05:38 PM
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")


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


I have tried:
.OnAction = "=AddRemoveButton()"
.OnAction = "AddRemoveButton()"
.OnAction = "AddRemoveButton"
.OnAction = AddRemoveButton

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

Thank you,
John :bink:

Zack Barresse
10-03-2004, 05:40 PM
Hi John, how are ya? :)

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

.OnAction = "Personal.xls!AddRemoveButton"

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

Jacob Hilderbrand
10-03-2004, 05:44 PM
Do you have a public sub AddRemoveButton ??

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


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

johnske
10-03-2004, 06:01 PM
Do you have a public sub AddRemoveButton ??

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


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:

Jacob Hilderbrand
10-03-2004, 07:14 PM
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.


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

johnske
10-03-2004, 07:54 PM
[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:


'****************************************************************
' 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.
'****************************************************************
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
'****************************************************************
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

johnske
10-03-2004, 08:01 PM
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.


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.....

Jacob Hilderbrand
10-03-2004, 08:27 PM
Try this one:


'************************************************* ***************
' 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.
'************************************************* ***************
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
'************************************************* ***************
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

johnske
10-04-2004, 12:32 AM
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....



'************************************************* ***************
' 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.
'************************************************* ***************
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
'************************************************* ***************
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

Jacob Hilderbrand
10-04-2004, 12:46 AM
You're Welcome

Take Care

johnske
10-04-2004, 07:58 PM
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:

'****************************************************************
' 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.
'****************************************************************
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.
'****************************************************************
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
'****************************************************************
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