Code Snippet Details

<- Back to List


Language
VBA
Description
Access - Ribbon callback methods
Code
'======================================================================================================================= ' Module: Navigation ' Purpose: Logic to handle navigation triggered by buttons being clicked in the custom ribbon. ' ' See the USysRibbons table which will need to be shown via the database options if not visible ' or use the CustomRibbonsView. ' ' Helpful links ' https://msdn.microsoft.com/en-us/library/dd548010(v=office.12).aspx ' https://msdn.microsoft.com/en-us/library/aa338202.aspx ' ' Public Methods: ' Navigation_OnRibbonLoad : Called at start-up ' Navigation_GetImage : Utility method used to load a buttom image ' Navigation_GetVisible : Utility method used to set the visibility of a button ' Navigation_GetEnabled : Utility method used to determine if a button is enabled ' Navigation_OnOpenForm : Utility method used to load a form named in a control's tag ' Private Methods ' SetAccessNavigationOptions : Disables some functionality to keep the solution locked down. '======================================================================================================================= Option Compare Database Option Explicit Private Const ModuleName As String = "Navigation" Global UIRibbon As IRibbonUI Public Sub Navigation_OnRibbonLoad(ribbon As IRibbonUI) ' This gets called when the ribbon loads - see the first line of the XML which refers to this procedure Const MethodName As String = "Navigation_OnRibbonLoad" On Error GoTo HandleError Set UIRibbon = ribbon InitialiseSolution ExitMethod: On Error GoTo 0 Exit Sub HandleError: ErrorHandler.LogError ModuleName, MethodName, Err Resume ExitMethod Resume Next End Sub Private Sub InitialiseSolution() Const MethodName As String = "InitialiseSolution" On Error GoTo HandleError SetAccessNavigationOptions False DataModificationGateway.GetCurrentUserDetails ExitMethod: On Error GoTo 0 Exit Sub HandleError: ErrorHandler.LogError ModuleName, MethodName, Err Resume ExitMethod Resume Next End Sub Public Sub Navigation_GetVisible(Control As IRibbonControl, ByRef visible) On Error GoTo HandleError Const MethodName As String = "Navigation_GetVisible" visible = False ' Retrieve permissions for the current user and set visible flag accordingly GetCurrentUserDetails Select Case CurrentUser.RoleID Case Roles.Developer ' Developer gets all options visible = True Case Else ' Nothing set End Select ' Enable the line below to use the log table for debugging purposes 'AddLogEntry "--Navigation_GetVisible: ControlID=" & Control.ID & " RoleID=" & CurrentUser.RoleID & " Visible=" & IIf(visible, "True", "False") ExitMethod: On Error GoTo 0 Exit Sub HandleError: ErrorHandler.LogError ModuleName, MethodName, Err Resume ExitMethod Resume Next End Sub Public Sub Navigation_GetEnabled(Control As IRibbonControl, ByRef enabled) ' All options are enabled for now as access is mainly controlled through visibility, ' but this method could be used to set the enabled status in future. Const MethodName As String = "Navigation_GetEnabled" enabled = True ' Enable the line below to use the log table for debugging purposes 'AddLogEntry " Navigation_GetEnabled: ControlID=" & Control.ID & " RoleID=" & CurrentUser.RoleID & " Enabled=" & IIf(enabled, "True", "False") End Sub Public Sub Navigation_OnOpenForm(Control As IRibbonControl) ' Open the form specified in the control's tag Const MethodName As String = "Navigation_OnOpenForm" On Error GoTo HandleError DoCmd.Hourglass True DoCmd.OpenForm Control.Tag DoEvents DoCmd.Hourglass False DoEvents ExitMethod: On Error GoTo 0 Exit Sub HandleError: ErrorHandler.LogError ModuleName, MethodName, Err Resume ExitMethod Resume Next End Sub Private Sub SetAccessNavigationOptions(enabled As Boolean) With CurrentDb .Properties("AllowSpecialKeys") = enabled .Properties("AllowFullMenus") = enabled .Properties("StartUpShowDBWindow") = enabled End With End Sub