动态控制 VBA 色带

Controlling VBA Ribbon Dynamically

我有一个应用程序,这是我第一次在其中使用功能区。我可以填充自己的控件并毫无问题地回调子程序。我现在正处于开发阶段,我希望动态地隐藏/显示一些组以提供更好的用户体验。

我可以通过更改 CallbackGetVisible 中的可见 属性 在工作簿加载期间隐藏/显示组,但是当我更改值并在应用程序 运行ning 时调用 RefreshRibbon 时,它在 Rib.Invalidate 处中断。测试显示 Rib (IRibbonUI) 对象 (Rib) 没有设置。有没有办法让对象保持活动状态,或者我还缺少其他东西?

XML

<!-- This is example : Custom tab for your favorite macros part 1   -->
<customUI onLoad="onLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <!-- Add Custom tab to the ribbon with your favorite buttons-->
  <!-- The example add three groups to the new tab -->
  <!-- On the last tab there is a menu with five options-->
  <ribbon>
    <tabs>
      <tab id="MyCustomTab" label="MIS DASHBOARD" insertAfterMso="TabHome">
        <group id="customGroup1" label="Menus">
          <menu id="MyDropdownMenu1" label="Dashboard" size="large" imageMso="ChartTypeOtherInsertGallery">
            <button id="customButton1" label="Dashboard Filters" onAction="ShowfrmDashboardFilters" imageMso="ViewsLayoutView" />
          </menu>
          <menu id="MyDropdownMenu2" label="Reports" size="large" imageMso="SlideMasterChartPlaceholderInsert">
        <button id="customButton2" label="Hub Templates" onAction="ShowfrmReportsTemplates" imageMso="CreateTableTemplatesGallery" />
        <button id="customButton3" label="Enter Exceptions" onAction="ShowfrmReportsExceptions" imageMso="TableDesign" />
          </menu>
          <menu id="MyDropdownMenu3" label="Admin" size="large" imageMso="FileDocumentEncrypt">
            <button id="customButton8" label="Data Entry" onAction="ShowfrmAdminDataEntry" imageMso="TableDesign" />
            <button id="customButton10" label="Manage Business Priorities" onAction="ShowfrmAdminBP" imageMso="QueryShowTable" />
            <button id="customButton11" label="Manage Templates" onAction="ShowfrmAdminTemplates" imageMso="CreateTableTemplatesGallery" />
            <button id="customButton12" label="Manage Metric Templates" onAction="ShowfrmAdminMetrics" imageMso="AccessListAssets" />
          </menu>
      <menu id="StaffDatabaseMenu" label="Staff Database" size="large" imageMso="CreateTableTemplatesGallery">
            <button id="customButton50" label="Update Data" onAction="ShowfrmStaffDatabase" imageMso="CreateTableTemplatesGallery" />
        <button id="customButton51" label="Add" onAction="ShowfrmStaffDatabaseAdd" imageMso="MailMergeRecipientsEditList" />
        <button id="customButton52" label="Delete" onAction="ShowfrmStaffDatabaseDelete" imageMso="PageMenu" />
          </menu>
    <menu id="MyDropdownMenu10" label="Local Data" size="large" imageMso="CreateReportFromWizard">
            <button id="customButton60" label="EWB" onAction="ShowfrmEWB" imageMso="CreateReportFromWizard" />
          </menu>
        </group>
    <group id="customGroup4" label="Support">
        <button id="customButton20" label="Feedback" size="large" onAction="ShowFeedback" imageMso="FileSendMenu" />
        <button id="customButton21" label="Guidance" size="large" onAction="ShowGuidance" imageMso="TentativeAcceptInvitation" />
        <button id="customButton22" label="Change Control" size="large" onAction="ShowChangeControl" imageMso="ReviewDisplayForReview" />
    </group>
    <group id="customGroup5" label="Actions" getVisible="CallbackGetVisible"> 
        <button id="customButton30" label="Save" size="large" onAction="ShowGuidance" imageMso="ExportToVCardFile" />
        <button id="customButton31" label="Cancel" size="large" onAction="ShowGuidance" imageMso="OmsDelete" />
    </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

代码

Option Private Module
Option Explicit
Const errModule As String = "modRibbon"

'Module Variables
Dim Rib As IRibbonUI
Public MyTag As String

Sub CallbackGetVisible(control As IRibbonControl, ByRef visible)

    visible = True

End Sub

Sub RefreshRibbon()

    Debug.Print "RefreshRibbon"
    If Rib Is Nothing Then
        MsgBox "Error, Save/Restart your workbook"
    Else
        Rib.Invalidate
    End If
End Sub

'==================================================================================================================================================================
'Called On Load From XML
'==================================================================================================================================================================
Sub onLoad(ByVal ribbon As IRibbonUI)
On Error GoTo err_Handle
Const strError As String = "Error - Please Contact " & gblDeveloper & " Quoting 'OnLoad'"

    Set Rib = ribbon
    Rib.ActivateTab ("MyCustomTab")
    GoTo Cleanup

'Set Any Objects to Nothing, Exits Sub
Cleanup:
    Set Rib = Nothing
    Exit Sub
'Throw Error
err_Handle:
    errMsg strError & Chr(10) & Err.Description & Chr(10) & errModule
    Resume Cleanup
End Sub

编辑

我的印象是 Rib.Invalidate 会导致 CallbackGetVisible 变为 运行,因此相应地设置组的可见性 属性。但是 Invalidate 不会 运行 而 Ribbon 是 Nothing.

您在子 onLoadCleanup: 部分将 Rib 设置为 Nothing

删除该行,只要保存 Rib 变量的代码模块处于打开状态,您就可以使用 Rib 对象。