VBA for Excel Add-In

[AD_Taylor]

Hi guys,

At the moment I have this code:

Private Sub Workbook_AddinInstall()

On Error Resume Next 'Just in case

    'Delete any existing menu item that may have been left.
    
    Dim CaptionName As String
    CaptionName = "Distribute Columns"

    Application.CommandBars("Worksheet Menu Bar").Controls(CaptionName).Delete

    'Add the new menu item and Set a CommandBarButton Variable to it

    Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add

    'Work with the Variable

        With cControl

            .Caption = CaptionName

            .Style = msoButtonCaption

            .OnAction = "ReSizeCols"

            'Macro stored in a Standard Module

        End With

End Sub

Is it possible to change this code so that it can add an icon next to the caption Distribute Columns?
This is with Excel 2007 - 2010 so the Add-Ins appear in their own portion of the Ribbon.

Also if it helps the macro ReSizeCols is a very simple macro that checks a selection made by the user, and makes all columns as wide as the largest one in that selection.

Thanks for any help,
Adam

 

[RoryA]

You need to assign a picture (or specify a FaceID when adding the control to use a built-in image). If you are using 2007 format files, you could also use RibbonX to actually create your own tab or group on an existing tab, rather than just getting dumped into the Addins tab. You can then specify your own image, size and so on.

 

[AD_Taylor]

You need to assign a picture (or specify a FaceID when adding the control to use a built-in image). If you are using 2007 format files, you could also use RibbonX to actually create your own tab or group on an existing tab, rather than just getting dumped into the Addins tab. You can then specify your own image, size and so on.

Thanks for this - would you be able to give some sample code for adding these?

It would mainly be the FaceID's as I want to use pre-existing Excel icons.

This also needs to (hopefully) work with Excel 2003 so I won't be looking into adding my own tab just yet

 

[RoryA]

You need to work out the FaceID of the control whose image you want, then use:

cControl.FaceID = 17

for example. J-Walk used to have a tool for listing FaceIDs on his site - I'll see if I can find it.

 

[RoryA]

Can't find it, but you can run this to create a list of controls with faceid and images on the activesheet:

Sub ListIDs()
    Dim mnuFile As CommandBar, lngRow As Long, lngColumn As Long
    Dim itmMenuItem As CommandBarControl, blnItemFound As Boolean
    Dim wks As Worksheet
    lngRow = 2
    On Error Resume Next
    Set wks = ActiveSheet
    Application.ScreenUpdating = False
   wks.Cells(1, 1).Resize(, 6).value = Array("Menu bar", "Caption", "ID", "FaceID", "Shortcut key", "Picture")
    For Each mnuFile In Application.CommandBars
        lngColumn = 1
        wks.Cells(lngRow, lngColumn).value = mnuFile.Name & " - " & mnuFile.Index
        lngColumn = 2
        For Each itmMenuItem In mnuFile.Controls
            With itmMenuItem
                wks.Cells(lngRow, lngColumn).value = .Caption
                wks.Cells(lngRow, lngColumn + 1).value = .ID
                wks.Cells(lngRow, lngColumn + 2).value = .FaceId
                wks.Cells(lngRow, lngColumn + 3).value = .accKeyboardShortcut
                .CopyFace
                wks.Paste wks.Cells(lngRow, lngColumn + 4)
                Application.CutCopyMode = False
                lngRow = lngRow + 1
            End With
        Next itmMenuItem
    Next mnuFile
    Application.ScreenUpdating = True
End Sub

 

[AD_Taylor]

This is a great piece of code!

Thanks for this - although more info makes more questions...

I had a look down the list of icons generated and I am specifically looking for the binouclars image associated with the Find menu item? I couldn't seem to see them listed anywhere in the file the code generates?

Also I've tried adding one of the ones that did come up in the generated file. Its the column width icon (FaceId = 542). Heres the code now:

Option Explicit

Dim cControl As CommandBarButton



Private Sub Workbook_AddinInstall()



On Error Resume Next 'Just in case

    'Delete any existing menu item that may have been left.
    
    Dim CaptionName As String
    CaptionName = "Distribute Columns"

    Application.CommandBars("Worksheet Menu Bar").Controls(CaptionName).Delete

    'Add the new menu item and Set a CommandBarButton Variable to it

    Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add

    'Work with the Variable

        With cControl

            .Caption = CaptionName

            .Style = msoButtonCaption

            .OnAction = "ReSizeCols"
            
            .FaceId = 542

            'Macro stored in a Standard Module

        End With

End Sub

but the FaceId image doesn't come up next to the button on the Add-Ins tab?
Any ideas why?

Again thanks for you help so far with this,
Adam

 

[AD_Taylor]

Sorted the second bit myself:

.Style = msoButtonCaption

became

.Style = msoButtonIconAndCaption

And the icon appears now. Only thing I think I need now definitive lists of FaceIds and corresponding images.

I'm currently looking for the image of the binoculars that is assigned to the Find command, and the text image assigned to the Replace command?

 

[RoryA]

Because you told it not to.

.Style = msoButtonCaption

needs to be:

.Style = msoButtonIconAndCaption

I was obviously being lazy when I wrote that code as it only loops through the top level controls on each bar. Try this one:

Sub ListIDs()
   Dim mnuFile As CommandBar, lngRow As Long, lngColumn As Long
   Dim itmMenuItem As CommandBarControl, blnItemFound As Boolean
   Dim wks As Worksheet
   Dim rngOut As Range
   On Error Resume Next
   Set wks = ActiveSheet
   StopScreen
   wks.Cells(1, 1).Resize(, 6).value = Array("Menu bar", "Caption", "ID", "FaceID", "Shortcut key", "Picture")
   Set rngOut = wks.Cells(2, 1)
   For Each mnuFile In Application.CommandBars
      rngOut.value = mnuFile.Name & " - " & mnuFile.Index
      Set rngOut = rngOut.Offset(1, 1)
      For Each itmMenuItem In mnuFile.Controls
         ListSubIDs itmMenuItem, rngOut
      Next itmMenuItem
      Set rngOut = rngOut.Offset(1, -1)
   Next mnuFile
   StartScreen
End Sub
Sub ListSubIDs(ctl As CommandBarControl, rngOut As Range)
   Dim ctlSub As CommandBarControl, itmMenuItem As CommandBarControl
   Dim lngCount As Long
   If ctl.Visible Then
      On Error Resume Next
      lngCount = ctl.Controls.Count
      On Error GoTo 0
      If lngCount > 0 Then
         rngOut.value = ctl.Caption
         Set rngOut = rngOut.Offset(1)
         For Each ctlSub In ctl.Controls
            ListSubIDs ctlSub, rngOut
         Next ctlSub
      Else
         With ctl
            rngOut.value = .Caption
            rngOut.Offset(, 1).value = .ID
            rngOut.Offset(, 2).value = .FaceId
            rngOut.Offset(, 3).value = .accKeyboardShortcut
            Application.CutCopyMode = False
            .CopyFace
            rngOut.Worksheet.Paste rngOut.Offset(, 4)
            Set rngOut = rngOut.Offset(1)
         End With
      End If
   End If

End Sub

 

[AD_Taylor]

Perfect!

Thanks for all your help with this - I now have a lot of little icons to play around with

Just a point about your code - it asks for StartScreen and StopScreen, which weren't included in the code you posted. I just commented these out and it ran fine.

Thanks again,
Adam

 

[RoryA]

Oh yes - for these purposes you can just turn screenupdating off and on instead.