gpt4 book ai didi

vba - 动态控制 VBA 功能区

转载 作者:行者123 更新时间:2023-12-02 18:03:24 26 4
gpt4 key购买 nike

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

我可以通过更改 CallbackGetVisible 中的可见属性在工作簿加载期间隐藏/显示该组,但是当我更改该值并在应用程序运行时调用 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 运行,因此相应地设置 Group 的可见属性。但当功能区为空时,Invalidate 将不会运行。

最佳答案

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

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

关于vba - 动态控制 VBA 功能区,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/33297638/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com