You are here: 22
22
Using Access 2007 and 2010 style Ribbons within one database
Am I able to use Application Ribbons for both Access versions (2007 and 2010) within one database?
Yes.
Setup Ribbon XML for all Ribbons in table USysRibbons.
Go to Options, Current Database, Ribbon and Toolbar Options, enter a Ribbon Name that does NOT exist in USysRibbons, e.g. "DBRibbon".
In a standard module add following code:
Option Compare Database Public Function fnc_LoadRibbon() Dim strProcName As String strProcName = "fnc_LoadRibbon" On Error GoTo fnc_LoadRibbon_Err Application.LoadCustomUI "DBRibbon", fnc_GetRibbon(Left(Application.Version, 2)) fnc_LoadRibbon_Exit: Exit Function fnc_LoadRibbon_Err: Select Case Err 'Case YourErrorNumber 'Resume fnc_LoadRibbon_Exit Case Else MsgBox "An error has occurred." & vbCrLf & vbCrLf & _ "In Function:" & vbTab & strProcName & vbCrLf & _ "Error number: " & vbTab & Err.Number & vbCrLf & _ "Description: " & vbTab & Err.description, vbCritical, _ "Error in " & Chr$(34) & strProcName & Chr$(34) Resume fnc_LoadRibbon_Exit End Select End Function Function fnc_GetRibbon(lngVersion As Long) As String ' ************************************************************ ' Created by : avenius ' Parameter : ' Return type : String ' Creation date : Wednesday, Aug 1, 2012 ' Comments : ' Updates : ' ' **************** Created by IDBE Tools 2010 **************** Dim strProcName As String strProcName = "fnc_GetRibbon" On Error GoTo fnc_GetRibbon_Err Dim dbs As DAO.Database Dim rst As DAO.Recordset Set dbs = CurrentDb() Select Case lngVersion Case 12 ' Read A2007 Ribbon Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='A2007'", dbOpenDynaset) Case 14 ' Read A2010 Ribbon Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='A2010'", dbOpenDynaset) Case Else ' Read default Ribbon Set rst = dbs.OpenRecordset("SELECT * FROM USysRibbons WHERE RibbonName='Default'", dbOpenDynaset) End Select rst.MoveFirst fnc_GetRibbon = rst.Fields("RibbonXml") fnc_GetRibbon_Exit: rst.Close Set rst = Nothing Set dbs = Nothing Exit Function fnc_GetRibbon_Err: Select Case Err 'Case YourErrorNumber 'Resume fnc_GetRibbon_Exit Case Else MsgBox "An error has occurred." & vbCrLf & vbCrLf & _ "In Function:" & vbTab & strProcName & vbCrLf & _ "Error number: " & vbTab & Err.Number & vbCrLf & _ "Description: " & vbTab & Err.description, vbCritical, _ "Error in " & Chr$(34) & strProcName & Chr$(34) Resume fnc_GetRibbon_Exit End Select End Function
Make sure function "fnc_LoadRibbon" will be loaded by Autoexec macro.
This sample is available as download.
Special thanks for the inspiration to Albert Kallal and Graham Mandeno.