VBA - Populate Custom Ribbon Drop Down/List Box

Question

I cannot get the drop down/list box to populate.

Original code from:

https://exceloffthegrid.com/inserting-a-dynamic-drop-down-in-ribbon/

How to add a custom Ribbon tab using VBA?

Below code for VBA is in one module and the XML code in a second module. The ribbon is created as the workbook opens.

My Code:

VBA:

Option Explicit

'testRibbon is a variable which contains the Ribbon
Public testRibbon As IRibbonUI

Sub testRibbon_onLoad(ByVal ribbon As Office.IRibbonUI)

    Set testRibbon = ribbon

End Sub

Public Sub DropDown_getItemCount(control As IRibbonControl, ByRef returnedVal)

    Dim Workbook As Workbook
    Dim Worksheet As Worksheet
    Dim myCell As Range
    Dim LastColumn As Long

    Set logBook = Workbooks("Journal.xlsm")
    Set dataSheet = logBook.Worksheets("Data Sheet")
    Set myCell = dataSheet.Range("B3")

    ColumnNumber = myCell.End(xlToRight).Column

    'Convert To Column Letter
    ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)

    Set myCell = dataSheet.Range("B3:" & ColumnLetter & "3")

    returnedVal = 0

    For x = 1 To myCell.Columns.Count

        card1 = myCell.Cells(1, x).Value

        If card1 <> "" And Len(card1 & vbNullString) > 0 Then

            returnedVal = returnedVal + 1

        End If

    Next x

End Sub

Public Sub DropDown_getItemID(control As IRibbonControl, index As Integer, ByRef id)

    id = "Base Currency: " & index

End Sub

Public Sub DropDown_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)

    Dim Workbook As Workbook
    Dim Worksheet As Worksheet
    Dim myCell As Range

    Set logBook = Workbooks("Journal.xlsm")
    Set dataSheet = logBook.Worksheets("Data Sheet")
    Set myCell = dataSheet.Range("B3")

    returnedVal = myCell.Value

End Sub

Public Sub DropDown_getSelectedItemID(control As IRibbonControl, ByRef id)

    id = "--SELECT--"

End Sub

Sub updateRibbon()

    testRibbon.Invalidate

End Sub

XML:

Sub LoadCustRibbon()

    Dim hFile As Long
    Dim path As String, fileName As String, ribbonXML As String, user As String

    hFile = FreeFile
    user = Environ("Username")
    path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
    fileName = "Excel.officeUI"

    ribbonXML = "               <mso:customUI      xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
    ribbonXML = ribbonXML + "       <mso:ribbon>" & vbNewLine
    ribbonXML = ribbonXML + "           <mso:qat/>" & vbNewLine
    ribbonXML = ribbonXML + "               <mso:tabs>" & vbNewLine

    'Group 1
    ribbonXML = ribbonXML + "                   <mso:tab id='myTab' label='Tab1' insertBeforeQ='mso:TabFormat'>" & vbNewLine

    ribbonXML = ribbonXML + "                       <mso:group id='sendSubmit' label='Submit' autoScale='true'>" & vbNewLine

                                                        'Drop Down
    ribbonXML = ribbonXML + "                           <mso:dropDown   id='DropDown' label='myList' " & vbNewLine
    ribbonXML = ribbonXML + "                               onAction='DropDown_onAction' " & vbNewLine
    ribbonXML = ribbonXML + "                               getSelectedItemID='DropDown_getSelectedItemID' " & vbNewLine
    ribbonXML = ribbonXML + "                               getItemLabel='DropDown_getItemLabel' " & vbNewLine
    ribbonXML = ribbonXML + "                               getItemID='DropDown_getItemID' " & vbNewLine
    ribbonXML = ribbonXML + "                               getItemCount='DropDown_getItemCount'" & vbNewLine
    ribbonXML = ribbonXML + "                           />" & vbNewLine

    ribbonXML = ribbonXML + "                       </mso:group>" & vbNewLine
    ribbonXML = ribbonXML + "                   </mso:tab>" & vbNewLine
    ribbonXML = ribbonXML + "               </mso:tabs>" & vbNewLine
    ribbonXML = ribbonXML + "           </mso:ribbon>" & vbNewLine
    ribbonXML = ribbonXML + "   </mso:customUI>"

    ribbonXML = Replace(ribbonXML, """", "")

    Open path & fileName For Output Access Write As hFile
    Print #hFile, ribbonXML
    Close hFile

End Sub

I have copied the code exactly as in the tutorial but I just cannot get the drop box to populate - even when I do it as they suggest with the sheets in the workbook.

Hope someone can help, this is driving me crazy. :/

Answer 1

Managed to find a tutorial that explains the correct usage of what I was trying to achieve.

Link:

https://www.contextures.com/excelribbonmacrostab.html

Highlights of the information in the link:

1. Download Custom UI Editor for Microsoft Office
2. Open the excel file you want to add the customizations to - using the Custom UI Editor
3. Right click on the file once loaded in the editor and choose your preferred office compatibility for the additional changes to work in (The 2010 option works for office 2010 - current)
4. An XML "file" will be created and linked to your original excel file WITHIN the editor
5. Insert your XML code into the editor
6. Do a code check by clicking on the Validate button in the task bar of the editor
7. Click the Generate Callbacks button which will create the sub's needed in VBA to pass parameters or identify elements on the XML (in the custom tab) - Copy the call backs to notepad
8. Provided everything looks good and the validation does not throw any errors, save the changes and open your excel file - which should now have the customizations in it
9. Paste the call backs in a module in VBA for the excel file with customizations

Example of XML Code for 2010 and Up:

Code:

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
    <ribbon startFromScratch="false">
        <tabs>
            <tab id="myLogTab" label="Logbook">

                <group id="setup" label="Setup">

                    <button 
                        id="btnSubmit" 
                        label="Submit" 
                        imageMso="GoTo" 
                        size="large" 
                        onAction="Submit" 
                    />

                    <dropDown   
                        id="ddlBase"
                        label="Base"
                        getItemCount="DropDown_getItemCount"
                        getItemLabel="DropDown_getItemLabel"
                        getSelectedItemIndex="GetSelItemIndex"
                        onAction="DropDown_onAction"

                    />

                    <editBox 
                        id="txtEntry"
                        label="Entry"
                        getText="MyEditBoxCallbackgetText"
                        onChange="MyEditBoxCallbackOnChange"
                    />

                </group>

                <group id="logSummary" label="Summary">

                    <labelControl 
                        id="lblTotal" 
                        label="Total" 
                    />

                </group>

            </tab>
        </tabs>
    </ribbon>
</customUI>

Example of VBA:

Code:

Option Explicit
'https://www.contextures.com/excelribbondynamictab.html
Public myRibbon As IRibbonUI

Sub Onload(ribbon As IRibbonUI)

    'Create a ribbon instance for use in this project
    Set myRibbon = ribbon

End Sub

'Callback for ddlBase getItemCount
Sub DropDown_getItemCount(control As IRibbonControl, ByRef count)

End Sub

'Callback for ddlBase getItemLabel
Sub DropDown_getItemLabel(control As IRibbonControl, Index As Integer, ByRef label)

End Sub

'Callback for ddlBase getSelectedItemIndex
Sub GetSelItemIndex(control As IRibbonControl, ByRef Index)

End Sub

'Callback for ddlBase onAction
Sub DropDown_onAction(control As IRibbonControl, id As String, Index As Integer)

End Sub

'Callback for txtEntry getText
Sub MyEditBoxCallbackgetText(control As IRibbonControl, ByRef returnedVal)

End Sub

'Callback for txtEntry onChange
Sub MyEditBoxCallbackOnChange(control As IRibbonControl, text As String)

End Sub