22

Ribbons für Access 2007 und 2010 in einer Datenbank verwenden

Kann ich in einer Datenbank für beide Access Versionen (2007 und 2010) unterschiedliche Application Ribbons verwenden?

Ja.

Erstellen Sie zunächst in der USysRibbons Tabelle die jeweils benötigten Ribbon XMLs.

Stellen Sie in den Optionen unter "Name der Multifunktionsleiste" für A2007 bzw. "Name des Menübandes" für A2010 einen Namen welcher nicht in der USysRibbonstabelle verwendnung findet  ein, z.B. "DBRibbon".

Fügen Sie folgenden Code in ein Standardmodul ein:

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 IhreFehlernummer
            'Resume fnc_LoadRibbon_Exit
        Case Else
            MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & vbCrLf & _
            "In Function:" & vbTab & strProcName & vbCrLf & _
            "Fehlernummer: " & vbTab & Err.Number & vbCrLf & _
            "Beschreibung: " & vbTab & Err.description, vbCritical, _
            "Fehler in " & Chr$(34) & strProcName & Chr$(34)
            Resume fnc_LoadRibbon_Exit
    End Select
 
End Function
 
Function fnc_GetRibbon(lngVersion As Long) As String
' ************************************************************
' Erstellt von     : avenius
' Parameter        :
' Rückgabe         : String
' Erstellungsdatum : Mittwoch, 1 Aug 2012
' Bemerkungen      :
' Änderungen       :
'
' **************** 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 IhreFehlernummer
            'Resume fnc_GetRibbon_Exit
        Case Else
            MsgBox "Es ist ein Fehler aufgetreten." & vbCrLf & vbCrLf & _
            "In Function:" & vbTab & strProcName & vbCrLf & _
            "Fehlernummer: " & vbTab & Err.Number & vbCrLf & _
            "Beschreibung: " & vbTab & Err.description, vbCritical, _
            "Fehler in " & Chr$(34) & strProcName & Chr$(34)
            Resume fnc_GetRibbon_Exit
    End Select
 
End Function

Stellen Sie sicher das die Function "fnc_LoadRibbon" über ein Autoexec Makro aufgerufen wird.

Sie finden unter den Downloads ein Beispiel Datei zum herunterladen.

Danke an A. Kallal und Graham Mandeno für die Anregung.