The way to set a default value on a RibbonX
dropDown control isn’t as obvious as it is with their ActiveX / Forms counterparts – there isn’t a simple property you can assign a value to – so I thought I’d finish off what I have to say on
dropDowns by showing you one way to do it using the template I published a few posts ago. You can download an updated, sample workbook from here.
For this example I want you to imagine that you have a workbook that interfaces with a database. Perhaps it pulls in data from certain tables or even allows the user to edit that data. A very typical situation would be that you have four different environments for the database: Development, User Acceptance Testing, Production and Disaster Recovery. By adding a
dropDown to the ribbon you can let the user choose which database environment to work with and you can even set a default environment when the workbook opens.
Here are the key changes I’ve made to the old template:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="wstRibbonX.RibbonOnLoad"> <ribbon > <tabs > <tab id="tabRADExcel" insertBeforeMso="TabInsert" label="RADExcel" tag="RADExcel" keytip="CSZ" getVisible="wstRibbonX.GetVisible"> <group id="grpRADExcelSheet1" label="RAD Excel Toolkit Sheet1" tag="grpSheet1" getVisible="wstRibbonX.GetVisible"> <button id="cmdForSheet1" imageMso="AccessRefreshAllLists" label="Special Button For Sheet 1" size="normal" onAction="wstRibbonX.cmdForSheet1_onAction" supertip="Only available for sheet1" /> <dropDown id="drpEnvironment" label="Environment: " onAction="wstRibbonX.drpEnvironment_onAction" getSelectedItemID="wstRibbonX.drpEnvironment_getSelectedItemID" supertip="Only available for sheet1"> <item id="Dev" label="Dev" /> <item id="UAT" label="UAT" /> <item id="Prod" label="Prod" /> <item id="DR" label="DR" /> </dropDown> </group> <group id="grpRADExcelSheet2" label="RAD Excel Toolkit Sheet2" tag="grpSheet2" getVisible="wstRibbonX.GetVisible"> <button id="cmdForSheet2" imageMso="FieldChooser" label="Special Button For Sheet 2" size="normal" onAction="wstRibbonX.cmdForSheet2_onAction" supertip="Only available for sheet2" /> </group> </tab > </tabs > </ribbon > </customUI >
VBA – wstRibbonX
Option Explicit 'credits: 'http://www.rondebruin.nl/win/s2/win015.htm 'http://www.rondebruin.nl/win/s2/win001.htm 'http://www.rondebruin.nl/win/s2/win012.htm '64-bit compatability #If VBA7 Then Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ ByRef Destination As Any, _ ByRef Source As Any, _ ByVal Length As Long) #Else Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ ByRef Destination As Any, _ ByRef Source As Any, _ ByVal Length As Long) #End If Private Const mstrRNG_RIBBONX_POINTER As String = "rRibbonXPointer" Private Const mstrRNG_ENVIRONMENT As String = "rEnvironment" Private Const mstrRAD_EXCEL_TAB As String = "RADExcel" Private muiRibbon As IRibbonUI Private mstrTag As String Public Property Get Environment() As String Environment = Range(mstrRNG_ENVIRONMENT).Value2 End Property 'this method will get a reference to the ribbon if it has been lost 'due to a state loss event Private Function GetRibbon() As Object '64-bit compatability #If VBA7 Then Dim lngRibPtr As LongPtr #Else Dim lngRibPtr As Long #End If Dim objRibbon As Object #If VBA7 Then lngRibPtr = CLngPtr(Range(mstrRNG_RIBBONX_POINTER).Value2) #Else lngRibPtr = CLng(Range(mstrRNG_RIBBONX_POINTER).Value2) #End If 'userinterfaceonly does not persist if the workbook is closed and reopened 'so if protectionmode is true then we are happy that the pointer is valid 'and from the current session If ProtectionMode And lngRibPtr <> 0 Then 'NB: CopyMemory will crash Excel if lngRibPtr is invalid CopyMemory objRibbon, lngRibPtr, LenB(lngRibPtr) Set GetRibbon = objRibbon Else MsgBox "RibbonOnLoad() failed to store a pointer to the IRibbonUI object." & _ vbNewLine & _ "The workbook needs to be closed and re-opened." End If End Function Private Sub SetControlDefaults() Const strDEFAULT_ENVIRONMENT As String = "UAT" 'set default value of Environment dropdown 'add more default values here if you have more controls.... Range(mstrRNG_ENVIRONMENT).Value2 = strDEFAULT_ENVIRONMENT End Sub Public Sub Initialise() 'By default the Tabs with GetVisible in the 'RibbonX are not Visible when the workbook is opened mstrTag = mstrRAD_EXCEL_TAB End Sub Public Sub RefreshRibbon(ByRef strTag As String) mstrTag = strTag If muiRibbon Is Nothing Then Set muiRibbon = GetRibbon If Not muiRibbon Is Nothing Then muiRibbon.Invalidate End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'CALLBACKS 'Callback for customUI.onLoad Public Sub RibbonOnLoad(ByVal objRibbon As IRibbonUI) Const strPASSWORD As String = "RADExcelSecret" Dim objActiveSheet As Object #If VBA7 Then Dim lngRibPtr As LongPtr #Else Dim lngRibPtr As Long #End If Set muiRibbon = objRibbon lngRibPtr = VBA.ObjPtr(objRibbon) 'wstRibbonX is very hidden, but password protection gives us added 'peace of mind that the cell holding the pointer to the ribbon can't 'be accidentally changed 'userinterfaceonly only persists while the workbook is open Protect Password:=strPASSWORD, UserInterfaceOnly:=True 'store ribbonX pointer Range(mstrRNG_RIBBONX_POINTER).Value2 = lngRibPtr 'set default values of Ribbon controls SetControlDefaults ThisWorkbook.Saved = True 'force ribbon to show correct buttons for the activesheet Set objActiveSheet = ThisWorkbook.ActiveSheet If Not objActiveSheet Is Nothing Then Activate objActiveSheet.Activate End If End Sub 'Callback for getVisible Public Sub GetVisible(ByVal ctlRibbon As IRibbonControl, ByRef returnVisible As Variant) returnVisible = (ctlRibbon.Tag = mstrRAD_EXCEL_TAB) Or (ctlRibbon.Tag = mstrTag) End Sub 'Callback for cmdForSheet1 onAction Public Sub cmdForSheet1_onAction(ByVal control As IRibbonControl) MsgBox "Hello!" End Sub 'Callback for cmdForSheet2 onAction Public Sub cmdForSheet2_onAction(ByVal control As IRibbonControl) MsgBox "Goodbye!" End Sub 'Callback for drpEnvironment onAction Public Sub drpEnvironment_onAction( _ ByVal control As IRibbonControl, _ ByVal id As String, _ ByVal index As Long) Range(mstrRNG_ENVIRONMENT).Value2 = id End Sub 'Callback for drpEnvironment GetSelectedItemID Public Sub drpEnvironment_GetSelectedItemID( _ ByVal control As IRibbonControl, _ ByRef itemID As Variant) itemID = Range(mstrRNG_ENVIRONMENT).Value2 End Sub
How Does It Work?
I’ve added a hidden name,
rEnvironment, to the workbook which references a cell in the very hidden RibbonX worksheet. When the ribbon is loaded the
RibbonOnLoad() procedure is called which puts the default value of “UAT” into the
rEnvironment cell. Each time the
drpEnvironment control is initialised, the
drpEnvironment_GetSelectedItemID() procedure is called and assigns the value from the
rEnvironment cell to the
drpEnvironment control. Finally, each time the user clicks on the
dropDown and selects a different environment from the list, the
dropEnvironment_onAction() procedure is called and updates the value stored in the cell.
To give the rest of the project access to the environment I’ve added a read-only property called
Environment which reads the value from the cell. Your code would use this property to determine the correct connection string whenever a call to the database is required. You can test this property by typing the below query into the Immediate Window:
Well, that’s it on
dropDown controls. If you’ve got any questions on how this code works then please post a comment.