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.