Non-consecutive FaceId

tquist

Board Regular
Joined
Jul 18, 2008
Messages
53
I'm not sure how to ask this question, so pardon my clumsiness. I have the following code (thanks to Andrewk32 for helping me put it together):

Code:
Private Sub Workbook_AddinInstall()

    Dim iCtr As Long

    Dim MacNames As Variant
    Dim CapNamess As Variant
    Dim TipText As Variant
    Dim Toolbarname As String
    
    Toolbarname = "Custom Toolbar"
    MacNames = Array("TableFrame.TableFrame", _
                     "TablePopulator.TablePopulator", _
                        "BoxPlotCreator.BoxPlotCreator ")

    CapNamess = Array("Create Table Outline", _
                      "Populate Table", _
                      "Create Box Plot")

    TipText = Array("Creates a table pre-formatted to work with the Box Plot Utility.  Do NOT disturb the formatting beyond adding additional columns or errors will likely occur!", _
                    "Calculates statistics and produces data necessary to create a box-and-whisker chart.  Make sure that the cell with the fiscal year label is selected before issuing this command!", _
                    "Creates a box-and-whisker chart. Make sure that the top-left cell of the title bar is selected before issuing this command!")
    
    With Application.CommandBars.Add(Toolbarname)
        .Left = 200
        .Top = 200
        .Protection = msoBarNoProtection
        .Visible = True
        .Position = msoBarFloating


        For iCtr = LBound(MacNames) To UBound(MacNames)
           With .Controls.Add(Type:=msoControlButton)
                .OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
                .Caption = CapNamess(iCtr)
                .Style = msoButtonIconAndCaption
                .FaceId = 107 + iCtr
                .TooltipText = TipText(iCtr)
            End With
        Next iCtr
    End With
End Sub

Private Sub Workbook_AddinUninstall()
    Dim Toolbarname As String
    
  Toolbarname = "Custom Toolbar"
    On Error Resume Next
Application.CommandBars(Toolbarname).Delete
End Sub

I would like to apply different FaceIds to each of my buttons. I don't want them to be consecutive (as the current setting indicates). I'd like the first button to have FaceId 107, the second to have 162, and the third to have 421. Is this possible within the current code layout? Thanks in advance for your help!
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Untested:

Code:
Private Sub Workbook_AddinInstall()

    Dim iCtr As Long

    Dim MacNames As Variant
    Dim CapNamess As Variant
    Dim TipText As Variant
    Dim FaceIDs As Variant
    Dim Toolbarname As String
    
    Toolbarname = "Custom Toolbar"
    MacNames = Array("TableFrame.TableFrame", _
                     "TablePopulator.TablePopulator", _
                        "BoxPlotCreator.BoxPlotCreator ")

    CapNamess = Array("Create Table Outline", _
                      "Populate Table", _
                      "Create Box Plot")


    FaceIDs = Array(107, 162, 421)

    TipText = Array("Creates a table pre-formatted to work with the Box Plot Utility.  Do NOT disturb the formatting beyond adding additional columns or errors will likely occur!", _
                    "Calculates statistics and produces data necessary to create a box-and-whisker chart.  Make sure that the cell with the fiscal year label is selected before issuing this command!", _
                    "Creates a box-and-whisker chart. Make sure that the top-left cell of the title bar is selected before issuing this command!")
    
    With Application.CommandBars.Add(Toolbarname)
        .Left = 200
        .Top = 200
        .Protection = msoBarNoProtection
        .Visible = True
        .Position = msoBarFloating


        For iCtr = LBound(MacNames) To UBound(MacNames)
           With .Controls.Add(Type:=msoControlButton)
                .OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
                .Caption = CapNamess(iCtr)
                .Style = msoButtonIconAndCaption
                .FaceId = FaceIDs(iCtr)
                .TooltipText = TipText(iCtr)
            End With
        Next iCtr
    End With
End Sub

Private Sub Workbook_AddinUninstall()
    Dim Toolbarname As String
    
  Toolbarname = "Custom Toolbar"
    On Error Resume Next
Application.CommandBars(Toolbarname).Delete
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,638
Messages
6,120,676
Members
448,977
Latest member
moonlight6

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top