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.