Access: Load and apply Custom Ribbon via VBA - ms-access

Question

I need to set some buttons for RunTime users.
I was created USysRibbon table, inserted XML and tested via Database options. All works fine.
But I need load Custom ribbon via VBA custom function. This function will be executed via AutoExec macro (after user login and user id as temp variable is set).
Please help me to create simple VBA to call LoadCustomUI function and get XML from table (in that table is ID, RibbonName and RibbonXML) and apply to user interface.
Thank you.

Answer 1

I assume that you have created your ribbon table like this : http://www.accessribbon.de/en/?Access_-_Ribbons:Load_Ribbons_Into_The_Database:..._Using_The_System_Table_USysRibbons
Let's say:
your AutoExec macro execute the function Start_App()
You have in your table a record with RibbonName="MyRibbon1"
Create a module with the following code
' This variable handle your ribbon name, so if you have several Ribbons in your table, you adapt this constant to match the current Ribbon
Public Const APP_RIBBON As String = "MyRibbon1"
Public Function Start_app()
On Error GoTo Err_Handler
LoadRibbons
' do anything else you need in the Start_app
Exit_Sub:
Exit Function
Err_Handler:
If Err.Number > 0 Then
MsgBox Err.DESCRIPTION, vbExclamation, "An error " & Err.Number & " occured !"
Debug.Print Err.Number
Resume Exit_Sub
End If
End Function
Private Function LoadRibbons()
On Error GoTo Error1
Dim RS As dao.Recordset
Set RS = CurrentDB.OpenRecordset("SELECT * FROM USysRibbon ")
Do Until RS.EOF
If RS("RibbonName").value = APP_RIBBON Then
' Ribbon found: Load it and exit
Application.LoadCustomUI APP_RIBBON, RS("RibbonXML").value
Exit Do
End If
RS.MoveNext
Loop
Error1_Exit:
On Error Resume Next
RS.Close
Set RS = Nothing
Exit Function
Error1:
Select Case Err
Case 32609
' Ribbon already loaded, do nothing and exit
Case Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.DESCRIPTION, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End Select
Resume Error1_Exit
End Function
Note that you have an additional thing to do: the first time you run the code, the Ribbon will not show. You have to go in the options / current database and in the combo box Ribbon Name: select the ribbon. If you have run the code once, your MyRibbon1 should appear in the combo box