How to set the default Ribbon for athe Current DB (1 Viewer)

[msowards]

Every where I look for an answer to this question I find the loadCustomUI, but the UI is loaded already, I want to change what the default ribbon is set to on the next opening. (i.e. when I close the Db I want to set the default ribbon to either of two defined ribbons in the USysRibbons table. I've succesfully used DB.properties to set DB properties like Startup form and BreakIntoCode... but when I Use it to change CustomRibbonID it doesn't seem to take affect. Here are two procedures that work in conjunction to allow the programmer to control these DB propeties...

Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Boolean
    
On Error GoTo Err_ChangeProperty

'
    Dim dbs As Database
    Dim prp As Property
    ChangeProperty = False
    Set dbs = CurrentDb
    
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

'
  
Exit_ChangeProperty:

        Set prp = Nothing
        Set dbs = Nothing
    Exit Function
    
Err_ChangeProperty:
    Select Case Err.Number
        Case 3270

          Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)

          Resume Next
        Case Else
            Dim ErrAns As Integer, ErrMsg As String
            If ErrChoice = vbYesNoCancel Then
                ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
                    "'No' to Exit Procedure." & vbCrLf & "or 'Cancel' to break into code"
            Else
                ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
                    "'No' to Exit Procedure."
            End If
            ErrAns = MsgBox(ErrMsg, _
                vbCritical + vbQuestion + ErrChoice, "ChangeProperty")
            If ErrAns = vbYes Then
                Resume Next
            ElseIf ErrAns = vbCancel Then
                On Error GoTo 0
                Resume
            Else
                ChangeProperty = False
                Resume Exit_ChangeProperty
            End If
    End Select
End Function
Public Sub SetStartupOptions(propname As String, propdb As Variant, prop As Variant)
On Error GoTo Err_SetStartupOptions

  'Set passed startup property.
  
  'some of the startup properties you can use...
  ' "StartupShowDBWindow", DB_BOOLEAN, False
  ' "StartupShowStatusBar", DB_BOOLEAN, False
  ' "AllowBuiltinToolbars", DB_BOOLEAN, False
  ' "AllowFullMenus", DB_BOOLEAN, False
  ' "AllowBreakIntoCode", DB_BOOLEAN, False
  ' "AllowSpecialKeys", DB_BOOLEAN, False
  ' "AllowBypassKey", DB_BOOLEAN, False
  
  Dim dbs As Object

  Dim prp As Object

  Set dbs = CurrentDb

    'this code is in the 2007 version

    If propname = "DBOpen" Then
        ChangeProperty "AllowBreakIntoCode", propdb, prop
        ChangeProperty "AllowSpecialKeys", propdb, prop
        ChangeProperty "AllowBypassKey", propdb, prop
        ChangeProperty "AllowFullMenus", propdb, prop
        ChangeProperty "StartUpShowDBWindow", propdb, prop
            
    Else
        dbs.Properties(propname) = prop
    End If
'     MsgBox "Security Parameter Missing!", vbExclamation + vbOKOnly
    
  Set dbs = Nothing

  Set prp = Nothing
  
Exit_SetStartupOptions:
    Exit Sub

Err_SetStartupOptions:
    Select Case Err.Number
        Case 3270

          Set prp = dbs.CreateProperty(propname, propdb, prop)

          Resume Next

        Case Else
            Dim ErrAns As Integer, ErrMsg As String
            If ErrChoice = vbYesNoCancel Then
                ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
                    "'No' to Exit Procedure." & vbCrLf & "or 'Cancel' to break into code"
            Else
                ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
                    "'No' to Exit Procedure."
            End If
            ErrAns = MsgBox(ErrMsg, _
                vbCritical + vbQuestion + ErrChoice, "SetStartupOptions")
            If ErrAns = vbYes Then
                Resume Next
            ElseIf ErrAns = vbCancel Then
                On Error GoTo 0
                Resume
            Else
                Resume Exit_SetStartupOptions
            End If
    End Select

End Sub

so when I call
If ChangeProperty("CustonRibbonID", dbText, "CustomRibn01")

it does not change the value I believe there must be another step because when the options dialog is use to manually select the default ribbon, Access displays a message saying you must restart the DB for the change to take affect. This does not happen when I try to change the vaule using the DB.properties method.

 

[speakers_86]

I have a sample posted in the sample forum.

edit- Here is the post. Help it helps.

 

[msowards]

That does the trick, but leaves me with questions. Why does the ribbon named "DoNotChange" become the 'Default' ribbon? and what about the application 'Default ribbon' would this override an entry manually updated in the Current Database options Screen?

 

[speakers_86]

Lets say your ribbons name is TestRibbon. When open Access, it will load whatever ribbon is called TestRibbon.

My sample has three fields, RibbonName, FriendlyName, and XML. The Friendly name is simply the name of your ribbon. The RibbonName is variable, either null or "DoNotChange". When you make a change in the combo box, the after update event makes the RibbonName DoNotChange, and all other ribbon names are null. It kinda tricks Access into loading the proper ribbon.

If you change the ribbon with the Access GUI, the combo box will not work. Thats why I used "DoNotChange" by the way.