动态控制 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.
您在子 onLoad
的 Cleanup:
部分将 Rib
设置为 Nothing
。
删除该行,只要保存 Rib
变量的代码模块处于打开状态,您就可以使用 Rib
对象。
我有一个应用程序,这是我第一次在其中使用功能区。我可以填充自己的控件并毫无问题地回调子程序。我现在正处于开发阶段,我希望动态地隐藏/显示一些组以提供更好的用户体验。
我可以通过更改 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.
您在子 onLoad
的 Cleanup:
部分将 Rib
设置为 Nothing
。
删除该行,只要保存 Rib
变量的代码模块处于打开状态,您就可以使用 Rib
对象。