' в форме опций:

If Me.chkDebugMode Then
    strRibbon = "Swan_DB_debug"
Else
    strRibbon = "Swan_DB"
    
    strBackStage = _
    "  <backstage>" & vbCrLf & _
    "     <button idMso=""FileCloseDatabase"" visible=""true""/>" & vbCrLf & _
    "     <button idMso=""SaveObjectAs"" visible=""false""/>" & vbCrLf & _
    "     <button idMso=""FileSaveAsCurrentFileFormat"" visible=""false""/>" & vbCrLf & _
    "     <button idMso=""FileOpen"" visible=""false""/>" & vbCrLf & _
    "     <button idMso=""FileSave"" visible=""false""/>" & vbCrLf & _
    "     <tab idMso=""TabInfo"" visible=""true""/>" & vbCrLf & _
    "     <tab idMso=""TabRecent"" visible=""false""/>" & vbCrLf & _
    "     <tab idMso=""TabNew"" visible=""false""/>" & vbCrLf & _
    "     <tab idMso=""TabPrint"" visible=""false""/>" & vbCrLf & _
    "     <tab idMso=""TabShare"" visible=""false""/>" & vbCrLf & _
    "     <tab idMso=""TabHelp"" visible=""false""/>" & vbCrLf & _
    "     <button idMso=""ApplicationOptionsDialog"" visible=""true""/>" & vbCrLf & _
    "     <button idMso=""FileExit"" visible=""true""/>" & vbCrLf & _
    "  </backstage>"
    
    strRes = ConvertRibbonDebugToProd("Swan_DB_debug", "Swan_DB", strBackStage)
    If strRes <> "" Then
        Err.Raise vbObjectError + 514, "ConvertRibbonDebugToProd", strRes
    End If
End If

SetAppRibbon strRibbon

MsgBox "You must close and reopen the current database for the specified option to take effect." & vbNewLine & _
        "You can use menu System -> Restart", vbInformation

'---------------------------------------------------------------------------------------
' Procedure : ConvertRibbonDebugToProd
' Purpose   : Converts debug ribbon to production with startFromScratch="true", hidden context system tabs and backstage
'---------------------------------------------------------------------------------------
'
Public Function ConvertRibbonDebugToProd(strRibbonDebug As String, strRibbonProd As String, Optional strBackStage As String = "") As String

    Dim varXML As Variant
    Dim strHideContTabs As String

   On Error GoTo ErrorHandler

  If strRibbonDebug = "" Or strRibbonProd = "" Then
        ConvertRibbonDebugToProd = "Argument(s) empty"
        Exit Function
    End If
    
    varXML = DLookup("RibbonXML", "USysRibbons", "RibbonName='" & strRibbonDebug & "'")
    
    If IsNull(varXML) Then
        ConvertRibbonDebugToProd = "Ribbon """ & strRibbonDebug & """ not found in USysRibbons"
        Exit Function
    End If
    
    'start from scratch
    varXML = Replace(varXML, "startFromScratch=""false""", "startFromScratch=""true""")
    
    'tags
    varXML = Replace(varXML, ":=" & strRibbonDebug & ";", ":=" & strRibbonProd & ";")
    
    'disable contextual system tabs
    
    If InStr(1, varXML, "</contextualTabs>") > 0 Then
        strHideContTabs = _
        "  <tabSet idMso=""TabSetFormDatasheet"" visible=""false"" />" & vbCrLf
        varXML = Replace(varXML, "</contextualTabs>", strHideContTabs & "</contextualTabs>")
    Else
        strHideContTabs = _
        "    <contextualTabs>" & vbCrLf & _
        "      <tabSet idMso=""TabSetFormDatasheet"" visible=""false"" />" & vbCrLf & _
        "    </contextualTabs>" & vbCrLf & "  "
    
        varXML = Replace(varXML, "</ribbon>", strHideContTabs & "</ribbon>")
    End If
    
    'backstage
    If Len(Trim(strBackStage)) > 0 Then
        varXML = Replace(varXML, "</customUI>", strBackStage & vbCrLf & "</customUI>")
    End If

    ' write back new XML
    With DBEngine(0)(0).OpenRecordset("USysRibbons", dbOpenDynaset)
        .FindFirst "[RibbonName] = '" & strRibbonProd & "'"
        If .NoMatch Then
            .AddNew
                ![RibbonName] = strRibbonProd
                ![RibbonXml] = varXML
            .Update
        Else
            .Edit
                ![RibbonXml] = varXML
            .Update
        End If
        .Close
    End With

ExitHere:
   On Error Resume Next
   Exit Function

ErrorHandler:
Select Case Err
Case 0
   Resume Next
Case Else
   LogError Err.Number, Err.Description, Erl, "ConvertRibbonDebugToProd", "basRibbon"
   Resume ExitHere
End Select

    
End Function

'---------------------------------------------------------------------------------------
' Procedure : SetAppRibbon
' Purpose   : Sets the ribbon, lodas to USysRibbons as default application ribbon. Access restart required
'---------------------------------------------------------------------------------------
'
Public Function SetAppRibbon(strRibbon As String) As Boolean

     On Error Resume Next
     CurrentDb.Properties("CustomRibbonID").Value = strRibbon
     If Err.Number = 3270 Then
         Err.Clear
         CurrentDb.Properties.Append CurrentDb.CreateProperty("CustomRibbonID", dbText, strRibbon)
         If Err.Number <> 0 Then GoTo ErrorHandler
     End If
    On Error GoTo ErrorHandler


ExitHere:
   On Error Resume Next
   Exit Function

ErrorHandler:
Select Case Err
Case 0
   Resume Next
Case Else
   LogError Err.Number, Err.Description, Erl, "SetAppRibbon", "basRibbon"
   Resume ExitHere
End Select


End Function