excel - Excel 自定义功能区切换按钮依赖项
问题描述
我正在尝试整理一个自定义菜单,并且我想要2个togglebuttons:“ chktoggle1”和“ chktoggle2”以相互排除,这意味着当检查1时,另一个不是,反之亦然。
<checkBox id="chkToggle1" getLabel="onGetLabel" getScreentip="onGetScreentip" getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" />
<checkBox id="chkToggle2" getLabel="onGetLabel" getScreentip="onGetScreentip" getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" />
你们能给我如何做到这一点的任何想法吗?理想情况下,应该有一种方法可以在不使用全局变量的情况下通过 control.id 从另一个控件获取按下的值,但 Google 并没有帮助我,也许你可以。
解决方案
在我的工作簿的 XML 中,我得到了:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad = "RibbonOnLoad">
<ribbon>
<tabs>
<tab id="customTab" label="Contoso" insertAfterMso="TabHome">
<group id="customGroup" label="Contoso Tools">
<checkBox id="chkToggle1" tag="chkToggle1" getLabel="onGetLabel" getScreentip="onGetScreentip" getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" getEnabled="GetEnabled" />
<checkBox id="chkToggle2" tag="chkToggle2" getLabel="onGetLabel" getScreentip="onGetScreentip" getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" getEnabled="GetEnabled" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>
我在我的工作簿中添加了一个名为RibbonReference
(我建议设置.Visible = xlSheetVeryHidden
)的工作表,然后将以下内容添加到模块中:
Option Explicit
Dim rib As IRibbonUI
Public ControlTag As String
Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal Operation As String, _
ByVal Filename As String, _
Optional ByVal Parameters As String, _
Optional ByVal Directory As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus _
) As Long
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#End If
#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
Dim objRibbon As Object
CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
Set GetRibbon = objRibbon
Set objRibbon = Nothing
End Function
Public Sub RefreshRibbon()
If rib Is Nothing Then
Set rib = GetRibbon(ThisWorkbook.Sheets("RibbonReference").Cells(2, 1).Value)
Else
rib.Invalidate
End If
End Sub
Sub RibbonOnLoad(ribbon As IRibbonUI)
Set rib = ribbon
Debug.Print "ribbon:-", ObjPtr(ribbon)
ThisWorkbook.Sheets("RibbonReference").Cells(2, 1).Value = ObjPtr(ribbon)
End Sub
Sub GetEnabled(control As IRibbonControl, ByRef enabled)
If control.Tag = ControlTag Or ControlTag = vbNullString Then
enabled = True
Else
enabled = False
End If
End Sub
'Callback for chkToggle1 getPressed
Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
If ControlTag = control.Tag Then
returnedVal = True
Else
returnedVal = False
End If
End Sub
'Callback for chkToggle1 onAction
Sub tgl_ClickAddin(control As IRibbonControl, pressed As Boolean)
If ControlTag = control.Tag Then
ControlTag = vbNullString
Else
ControlTag = control.Tag
End If
RefreshRibbon
End Sub
'Callback for chkToggle1 getLabel
Sub onGetLabel(control As IRibbonControl, ByRef returnedVal)
End Sub
'Callback for chkToggle1 getScreentip
Sub onGetScreentip(control As IRibbonControl, ByRef returnedVal)
End Sub
'Callback for chkToggle1 getSupertip
Sub onGetSupertip(control As IRibbonControl, ByRef returnedVal)
End Sub
给出结果
推荐阅读
- python - Raspberry Pi 4 上的断言失败
- mongodb - Spring boot mongo返回dbref列表字段为空,即使数据存在于db中
- python - 使用环境变量作为应用程序配置运行 Flask 包
- php - 如何在 Codeigniter 中使用数据表
- laravel - Laravel Queue 突然停止服务
- akka-stream - 累积在一个入口的扇入算子
- c# - 无法将方法组“QueryFrame”转换为非委托类型“Image”
' C# - java - Java - 在 double 和 int 之间进行比较以及在 double 之间进行比较
- velo - 如何在 Wix 中为自动生成的 URL 创建系统字段?
- javascript - 如何使用两个按钮的 onClick() 事件在 JavaScript 中更改两种不同的背景颜色