The same event handler for two CommandBar buttons
Thank you!
I would prefer to guarantee appropriate functionality programmatically.
These are Add-ins, and they create commandbars every time Excel starts up.
"Joel" wrote:
You may have to change the properties in the buttons. To do this you have to
enter design mode.
1) On the spreadsheet, go to View Menu - Toolbars - Control Tool box.
2) Select Design Mode icon
3) Click on either of the two buttons.
4) Select Properties on the Control tool box.
You have to press the Design Mode Icon a second time to leave design mode
and to test the changes.
"vbapro" wrote:
The same event handler for two CommandBar buttons
I add custom command
There are who similar XLA AddIns which add commandbars. The names of
commandbars are different and are formed from the name of the corresponding
xla file.
But the event handlers have the same names; it leads to the fact that
clicking on a button of any commandbar calls identical event handler. To be
exact, the handler from the file, which has been opened in the first
instance, is called.
I suppose that the same ID of the buttons causes the problem, but I failed
to add a button with my own ID.
Is there a solution for this issue?
Thank you!
Here is my code:
Option Explicit
Option Compare Text
Public strCommandBarName As String
Const strParameters = "Parameters"
Sub AddCommandBar()
Dim c As CommandBar
Dim CB As CommandBarButton
Dim cp As CommandBarPopup
On Error Resume Next
strCommandBarName = ThisWorkbook.Name
strCommandBarName = Replace(strCommandBarName, ".xla", "")
Set c = Application.CommandBars(strCommandBarName)
If Not c Is Nothing Then
Application.CommandBars(strCommandBarName).Delete
End If
Set c = Application.CommandBars.Add(strCommandBarName, msoBarTop, False,
False)
c.Enabled = True
c.Visible = True
Set CB = c.Controls.Add(msoControlButton, 1)
CB.Style = msoButtonIconAndCaption
CB.Caption = strParameters
CB.OnAction = ThisWorkbook.Name & "!" & "OnActionParameters"
CB.FaceId = 304
End Sub
Sub DeleteCommandBar()
Dim c As CommandBar
On Error Resume Next
Set c = Application.CommandBars(strCommandBarName)
If Not c Is Nothing Then
Application.CommandBars(strCommandBarName).Delete
End If
End Sub
Private Sub OnActionParameters()
MsgBox ThisWorkbook.Name
End Sub
Function GetMyIndex() As String
Dim FileName As String
FileName = ThisWorkbook.Name
FileName = Replace(FileName, ".xla", "")
GetMyIndex = Mid(FileName, Len("ReplaceOnMask") + 1)
End Function
|