2016-03-10 44 views
0

我需要为RunTime用户设置一些按钮。访问:通过VBA加载和应用自定义功能区

我创建了USysRibbon表,插入了XML并通过数据库选项进行了测试。一切正常。

但我需要通过VBA自定义函数加载自定义功能区。此函数将通过AutoExec宏执行(在用户登录和用户标识为temp变量后)。

请帮助我创建简单的VBA来调用LoadCustomUI函数并从表中获取XML(在该表中是ID,RibbonName和RibbonXML)并应用于用户界面。

谢谢。

回答

2

我假定你已经创建了带状的表是这样的:http://www.accessribbon.de/en/?Access_-_Ribbons:Load_Ribbons_Into_The_Database:..._Using_The_System_Table_USysRibbons

比方说:

  1. 您的AutoExec宏与RibbonName =执行功能Start_App()
  2. 您的表中的记录“MyRibbon1”

用下面的代码创建一个模块

' This variable handle your ribbon name, so if you have several Ribbons in your table, you adapt this constant to match the current Ribbon 

Public Const APP_RIBBON As String = "MyRibbon1" 


Public Function Start_app() 

    On Error GoTo Err_Handler 

    LoadRibbons 

    ' do anything else you need in the Start_app  

Exit_Sub: 
    Exit Function 

Err_Handler: 
    If Err.Number > 0 Then 
     MsgBox Err.DESCRIPTION, vbExclamation, "An error " & Err.Number & " occured !" 
     Debug.Print Err.Number 
     Resume Exit_Sub 
    End If 

End Function 


Private Function LoadRibbons() 

     On Error GoTo Error1 

     Dim RS As dao.Recordset 

     Set RS = CurrentDB.OpenRecordset("SELECT * FROM USysRibbon ") 

    Do Until RS.EOF 

     If RS("RibbonName").value = APP_RIBBON Then 
       ' Ribbon found: Load it and exit 
      Application.LoadCustomUI APP_RIBBON, RS("RibbonXML").value 
      Exit Do 
     End If 

     RS.MoveNext 

    Loop 

Error1_Exit: 

    On Error Resume Next 
    RS.Close 
    Set RS = Nothing 
    Exit Function 

Error1: 

    Select Case Err 
     Case 32609 
     ' Ribbon already loaded, do nothing and exit 
    Case Else 
     MsgBox "Error: " & Err.Number & vbCrLf & Err.DESCRIPTION, vbCritical, "Error", Err.HelpFile, Err.HelpContext 
    End Select 

    Resume Error1_Exit 

End Function 

请注意,您还有一件事要做:首次运行代码时,功能区将不显示。您必须进入选项/当前数据库并在组合框Ribbon Name:中选择功能区。如果你已经运行了一次代码,你的MyRibbon1应该出现在组合框中

+0

谢谢。但我无法在选项/当前数据库中打开custiom功能区。在这种情况下,完整Access用户隐藏了所有功能区控件。我只需要运行时用户的自定义功能区。没有完全访问版本的管理员。我有登录表单和登录宏来设置用户ID。它使用用户ID设置临时变量 - 我可以在会话中工作。 –