如何在Access中为特定用户设置工具栏等显示及解决权限切换失效问题？

切换权限级别后，导航窗格、功能区等界面设置无法立即生效，必须重启数据库才能正常显示，核心原因是原代码中的部分设置在当前会话不会自动刷新，需要通过额外操作强制触发界面更新。

原代码的问题点 #

1. 用DoCmd控制导航窗格的方式不够可靠，无法即时更新其可见性和锁定状态
2. 修改数据库属性后未触发窗口和功能区刷新，导致设置不能立即生效
3. 存在未使用的冗余变量AccessLevel

修改后的代码 #

Private Sub ToolBars()
    Dim UserALevel As Integer
    Dim navPane As NavigationPane

    UserALevel = [Forms]![frmLogin]![AccessLeveltxtbox]

    ' 获取导航窗格对象，直接控制状态
    Set navPane = CurrentDb.Containers("Databases").Documents("NavPane").NavigateTo

    If UserALevel = 1 Then
        ' 启用全权限设置
        Application.SetOption "Show Hidden Objects", True
        
        ' 检查并设置数据库属性（避免属性不存在报错）
        If Not CurrentDb.Properties.Exists("AllowFullMenus") Then
            CurrentDb.Properties.Append CurrentDb.CreateProperty("AllowFullMenus", dbBoolean, True)
        Else
            CurrentDb.Properties("AllowFullMenus") = True
        End If
        
        If Not CurrentDb.Properties.Exists("AllowShortcutMenus") Then
            CurrentDb.Properties.Append CurrentDb.CreateProperty("AllowShortcutMenus", dbBoolean, True)
        Else
            CurrentDb.Properties("AllowShortcutMenus") = True
        End If
        
        If Not CurrentDb.Properties.Exists("AllowBuiltinToolbars") Then
            CurrentDb.Properties.Append CurrentDb.CreateProperty("AllowBuiltinToolbars", dbBoolean, True)
        Else
            CurrentDb.Properties("AllowBuiltinToolbars") = True
        End If
        
        ' 解锁并显示导航窗格
        navPane.Locked = False
        navPane.Visible = True
        
        ' 显示功能区和状态栏
        DoCmd.ShowToolbar "Ribbon", acToolbarYes
        DoCmd.ShowToolbar "Status Bar", acToolbarYes
        
        ' 强制刷新，确保设置即时生效
        DoCmd.RunCommand acCmdRefreshDatabaseWindow
        CommandBars("Ribbon").Refresh
    Else
        ' 启用受限权限设置
        Application.SetOption "Show Hidden Objects", False
        
        ' 检查并设置数据库属性
        If Not CurrentDb.Properties.Exists("AllowFullMenus") Then
            CurrentDb.Properties.Append CurrentDb.CreateProperty("AllowFullMenus", dbBoolean, False)
        Else
            CurrentDb.Properties("AllowFullMenus") = False
        End If
        
        If Not CurrentDb.Properties.Exists("AllowShortcutMenus") Then
            CurrentDb.Properties.Append CurrentDb.CreateProperty("AllowShortcutMenus", dbBoolean, False)
        Else
            CurrentDb.Properties("AllowShortcutMenus") = False
        End If
        
        If Not CurrentDb.Properties.Exists("AllowBuiltinToolbars") Then
            CurrentDb.Properties.Append CurrentDb.CreateProperty("AllowBuiltinToolbars", dbBoolean, False)
        Else
            CurrentDb.Properties("AllowBuiltinToolbars") = False
        End If
        
        ' 锁定并隐藏导航窗格
        navPane.Locked = True
        navPane.Visible = False
        
        ' 隐藏功能区和状态栏
        DoCmd.ShowToolbar "Ribbon", acToolbarNo
        DoCmd.ShowToolbar "Status Bar", acToolbarNo
        
        ' 强制刷新
        DoCmd.RunCommand acCmdRefreshDatabaseWindow
        CommandBars("Ribbon").Refresh
    End If
    
    ' 释放对象变量
    Set navPane = Nothing
End Sub

关键修改说明 #

• 直接控制导航窗格：用NavigationPane对象替代DoCmd命令，能更可靠地即时修改导航窗格的锁定和可见状态
• 属性存在性检查：添加属性存在性判断，避免首次运行时因属性不存在导致的报错
• 强制刷新操作：通过acCmdRefreshDatabaseWindow刷新数据库窗口，CommandBars("Ribbon").Refresh刷新功能区，确保所有设置变更立即生效
• 清理冗余代码：移除未使用的AccessLevel变量，简化逻辑

内容的提问来源于stack exchange，提问作者JBART