breakpoints 相关问题

我使用 Office Ribbon X 编辑器为 Excel 创建了自定义功能区 UI。该功能区上有几个切换按钮。 XML 看起来像这样：我使用 Office Ribbon X 编辑器为 Excel 创建了一个自定义功能区 UI。该功能区上有几个切换按钮。 XML 如下所示： <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="OnRibbonLoad"> <ribbon> <tabs> <tab id="customTab" label="MyRibbon" insertAfterMso="TabHome"> <group id="customGroup1" label="MyButtons"> <toggleButton id="customButton1" label="Label1" getPressed="GetPressed" onAction="AnyButtonGotPressed"/> <toggleButton id="customButton2" label="Label2" getPressed="GetPressed" onAction="AnyButtonGotPressed"/> <toggleButton id="customButton3" label="Label3" getPressed="GetPressed" onAction="AnyButtonGotPressed"/> [...] </group> </tab> </tabs> </ribbon> </customUI 如果用户按下其中一个按钮，则会执行一个宏，然后“侦听”用户在工作簿单元格中执行的单击操作，并对单击的单元格进行填充，具体取决于当前按下的切换按钮。由于用户知道将执行哪个宏非常重要，因此有必要一次只能“切换”一个切换按钮（在活动状态的意义上，true、1、按下... ). 因此我尝试编写一个例程，将所有切换按钮放入一个数组中并循环遍历该数组以使每个与触发例程的控件不匹配的control.ID 无效。我以某种方式实现它，自定义功能区上的每个切换按钮都调用“AnyButtonGotPressed”事件，然后该事件执行循环和无效，然后使用 Select Case 语句调用相关宏。 VBA 代码如下所示，并且对于“第一”、“第二”和“第三”宏基本相同： Option Explicit Public myRibbon As IRibbonUI Public pressed As Boolean ---------------------------------------------------------------------------------- Sub OnRibbonLoad(ribbon As IRibbonUI) Set myRibbon = ribbon End Sub ---------------------------------------------------------------------------------- Sub GetPressed(control As IRibbonControl, ByRef returnedVal) 'However this seems to be neccessary to "unpress" the toggleButtons End Sub ---------------------------------------------------------------------------------- Sub AnyButtonGotPressed(control As IRibbonControl, IsPressed) Dim arrButtons As Variant Dim varButton As Variant arrButtons = Array("customButton1", "customButton2", "customButton3") For Each varButton In arrButtons If Not varButton = control.ID Then myRibbon.InvalidateControl varButton Next pressed = IsPressed Select Case control.ID Case "customButton1" Call FirstMacro(control.ID) Case "customButton2" Call SecondMacro(control.ID) Case "customButton3" Call ThirdMacro(control.ID) End Select End Sub ---------------------------------------------------------------------------------- Sub FirstMacro(ButtonName As String) If Not pressed Then GoTo ErrorHandler On Error GoTo ErrorHandler With ThisWorkbook.Sheets(1) Continue: .Range("A1").Select Do While Selection.Address = "$A$1" DoEvents If Not pressed Then GoTo ErrorHandler Loop 'Here comes stuff to do with the cell, if the user clicks somewhere out of "A1" If pressed Then GoTo Continue End With ErrorHandler: myRibbon.InvalidateControl ButtonName End Sub 不幸的是，这并不能按预期工作，即如果用户选择一个新按钮，切换按钮不会“取消切换”。相反，所有连续选定的按钮都会同时按下。在尝试调试时，我发现如果我在“AnyButtonGotPressed”的“Select Case”处放置断点，它会变得很奇怪：我收到的“无法在中断模式下执行代码”警告与我拥有与“AnyButtonGotPressed”相关的切换按钮一样多。单击“确定”后代码继续执行并按预期工作，这意味着所有其他切换按钮均未按下，只有最后按下的按钮显示为当前按下的功能区。但不幸的是，如果没有断点，我无法让它像我想要的那样工作。我已经尝试在“invalidate”循环中添加几个“DoEvents”，然后还将Application.ScreenUpdating设置为False和True以及.EnableEvents但没有成功，功能区不会在没有成功的情况下取消按下toggleButtons断点。我还在没有循环的情况下进行了尝试，并在另一个之后放置了几个“If”语句，以使应取消按下的切换按钮无效。但这些都没有帮助。请您给我一些想法，如何解决这个问题？如果可能的话，我更喜欢最简单/最简单的解决方案，因为会有超过 14 个切换按钮（我也已经与 chatGPT 进行了辩论，但她的建议并不简单和/或不起作用 - 比如添加DoEvents 和 100 毫秒的中断以避免计时问题）。首先，我们需要一种在工作簿中存储数据的方法。您可以使用命名范围或其他内容，但我将使用我的库 LibExcelBookItems，因为它非常易于使用。 LibExcelBookItems模块的代码也在这里： '''============================================================================= ''' Excel VBA Tools ''' ----------------------------------------------- ''' https://github.com/cristianbuse/Excel-VBA-Tools ''' ----------------------------------------------- ''' MIT License ''' ''' Copyright (c) 2018 Ion Cristian Buse ''' ''' Permission is hereby granted, free of charge, to any person obtaining a copy ''' of this software and associated documentation files (the "Software"), to ''' deal in the Software without restriction, including without limitation the ''' rights to use, copy, modify, merge, publish, distribute, sublicense, and/or ''' sell copies of the Software, and to permit persons to whom the Software is ''' furnished to do so, subject to the following conditions: ''' ''' The above copyright notice and this permission notice shall be included in ''' all copies or substantial portions of the Software. ''' ''' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ''' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ''' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ''' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ''' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ''' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ''' IN THE SOFTWARE. '''============================================================================= '******************************************************************************* '' Description: '' - Simple strings can be stored/retrieved using CustomXMLParts per book '' - This module encapsulates the XML logic and exposes easy-to-use methods '' without the need to write actual XML '' Public/Exposed methods: '' - BookItem - parametric property Get/Let '' - GetBookItemNames '' Notes: '' - To delete a property simply set the value to a null string '' e.g. BookItem(ThisWorkbook, "itemName") = vbNullString '******************************************************************************* Option Explicit Option Private Module Private Const XML_NAMESPACE As String = "ManagedExcelCustomXML" Private Const rootName As String = "root" '******************************************************************************* 'Returns the Root CustomXMLPart under the custom namespace 'part is created if missing! '******************************************************************************* Private Function GetRootXMLPart(ByVal book As Workbook) As CustomXMLPart Const xmlDeclaration As String = "<?xml version=""1.0"" encoding=""UTF-8""?>" Const rootTag As String = "<" & rootName & " xmlns=""" & XML_NAMESPACE _ & """></" & rootName & ">" Const rootXmlPart As String = xmlDeclaration & rootTag ' With book.CustomXMLParts.SelectByNamespace(XML_NAMESPACE) If .Count = 0 Then Set GetRootXMLPart = book.CustomXMLParts.Add(rootXmlPart) Else Set GetRootXMLPart = .Item(1) End If End With End Function '******************************************************************************* 'Clears all CustomXMLParts under the custom namespace '******************************************************************************* Private Sub ClearRootXMLParts(ByVal book As Workbook) With book.CustomXMLParts.SelectByNamespace(XML_NAMESPACE) Dim i As Long For i = .Count To 1 Step -1 .Item(i).Delete Next i End With End Sub '******************************************************************************* 'Get the Root Node under the custom namespace 'Node is created if missing! '******************************************************************************* Private Function GetRootNode(ByVal book As Workbook) As CustomXMLNode Dim root As CustomXMLNode If root Is Nothing Then With GetRootXMLPart(book) Dim nsPrefix As String nsPrefix = .NamespaceManager.LookupPrefix(XML_NAMESPACE) Set root = .SelectSingleNode("/" & nsPrefix & ":" & rootName & "[1]") End With End If Set GetRootNode = root End Function '******************************************************************************* 'Get an XML Node. Create it if missing '******************************************************************************* Private Function GetNode(ByVal book As Workbook _ , ByVal nodeName As String _ , ByVal addIfMIssing As Boolean) As CustomXMLNode Dim node As CustomXMLNode Dim expr As String ' With GetRootNode(book) expr = .XPath & "/" & nodeName & "[1]" Set node = .SelectSingleNode(expr) If node Is Nothing And addIfMIssing Then .AppendChildNode nodeName Set node = .SelectSingleNode(expr) End If End With Set GetNode = node End Function '******************************************************************************* 'Retrieves/sets a book property value from a CustomXMLNode '******************************************************************************* Public Property Get BookItem(ByVal book As Workbook _ , ByVal itemName As String) As String ThrowIfInvalid book, itemName Dim node As CustomXMLNode Set node = GetNode(book, itemName, False) If Not node Is Nothing Then BookItem = node.Text End Property Public Property Let BookItem(ByVal book As Workbook _ , ByVal itemName As String _ , ByVal itemValue As String) ThrowIfInvalid book, itemName If LenB(itemValue) = 0 Then Dim node As CustomXMLNode Set node = GetNode(book, itemName, False) If Not node Is Nothing Then node.Delete Else GetNode(book, itemName, True).Text = itemValue End If End Property Private Sub ThrowIfInvalid(ByRef book As Workbook, ByRef itemName As String) Const methodName As String = "BookItem" If book Is Nothing Then Err.Raise 91, methodName, "Book not set" ElseIf LenB(itemName) = 0 Then Err.Raise 5, methodName, "Invalid item name" End If End Sub '******************************************************************************* 'Returns a collection of custom node names within the custom namespace '******************************************************************************* Public Function GetBookItemNames(ByVal book As Workbook) As Collection If book Is Nothing Then Err.Raise 91, "GetBookItemNames", "Book not set" ' Dim coll As New Collection With GetRootNode(book).ChildNodes Dim i As Long ReDim arr(0 To .Count - 1) For i = 1 To .Count coll.Add .Item(i).BaseName Next i End With Set GetBookItemNames = coll End Function 调用示例： BookItem(ThisWorkbook, "myVar") = myTextValue Debug.Print BookItem(ThisWorkbook, "myVar") 现在我们有了一种持久存储数据的方法，让我们确保在状态丢失的情况下可以恢复功能区。替换这个： Option Explicit Public myRibbon As IRibbonUI Public pressed As Boolean ---------------------------------------------------------------------------------- Sub OnRibbonLoad(ribbon As IRibbonUI) Set myRibbon = ribbon End Sub 这样： Option Explicit Private myRibbon As IRibbonUI #If Mac Then #If VBA7 Then Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr #Else Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long #End If #Else 'Windows 'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx #If VBA7 Then Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) #Else Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) #End If #End If Sub OnRibbonLoad(ByVal ribbon As IRibbonUI) Set SafeRibbon = ribbon End Sub '=============================================================================== 'Set/Get Ribbon object '=============================================================================== Private Property Set SafeRibbon(ByVal ribbonUI As IRibbonUI) Set myRibbon = ribbonUI Dim mustAvoidSaveDialog As Boolean mustAvoidSaveDialog = ThisWorkbook.IsAddin And ThisWorkbook.Saved BookItem(ThisWorkbook, "BookPtr") = CStr(ObjPtr(ThisWorkbook)) BookItem(ThisWorkbook, "RibbonPtr") = CStr(ObjPtr(myRibbon)) If mustAvoidSaveDialog Then ThisWorkbook.Saved = True End Property Public Property Get SafeRibbon() As IRibbonUI If myRibbon Is Nothing Then If BookItem(ThisWorkbook, "BookPtr") = CStr(ObjPtr(ThisWorkbook)) Then 'Restore ribbon #If Win64 Then Dim ptr As LongLong Const ptrSize As Long = 8 #Else Dim ptr As Long Const ptrSize As Long = 4 #End If Dim obj As Object ' ptr = Int(BookItem(ThisWorkbook, "RibbonPtr")) CopyMemory obj, ptr, ptrSize 'Unmanaged - reference not counted Set myRibbon = obj CopyMemory obj, 0, ptrSize 'Reference count not decremented End If End If Set SafeRibbon = myRibbon End Property 请注意，myRibbon 现在是私有的，并且只能对 SafeRibbon 参数属性进行调用。另请注意，我删除了 pressed 模块成员 - 我们不再需要它了。当一个宏已经在循环中运行时，我们不能简单地调用另一个宏。我们必须等待第一个退出。我们可以使用异步调用来实现这一点。我们还可以使用图书项目库来检索发生失效时最后按下的按钮的状态： Sub GetPressed(control As IRibbonControl, ByRef returnedVal) Dim lastIDPressed As String ' lastIDPressed = BookItem(ThisWorkbook, "lastIDPressed") returnedVal = (lastIDPressed = control.ID) If Len(lastIDPressed) > 0 Then AsyncMacro lastIDPressed End Sub Sub AnyButtonGotPressed(control As IRibbonControl, IsPressed) If Not IsPressed Then BookItem(ThisWorkbook, "lastIDPressed") = vbNullString Exit Sub End If ' BookItem(ThisWorkbook, "lastIDPressed") = control.ID If Not isMacroRunning Then AsyncMacro control.ID End Sub Private Sub AsyncMacro(ByVal ctrlID As String) Application.OnTime Now(), CallbackName("AsyncMacroCallback", ctrlID) End Sub Private Function CallbackName(ByVal funcName As String, ByVal ctrlID As String) As String CallbackName = "'" & Replace(ThisWorkbook.Name, "'", "''") _ & "'!'" & funcName & " """ & ctrlID & """'" End Function Public Sub AsyncMacroCallback(Optional ByVal ctrlID As String) isMacroRunning = True Select Case ctrlID Case "customButton1": FirstMacro ctrlID Case "customButton2": SecondMacro ctrlID Case "customButton3": ThirdMacro ctrlID Case Else '... End Select BookItem(ThisWorkbook, ctrlID) = CStr(False) SafeRibbon.InvalidateControl ctrlID isMacroRunning = False End Sub 其中 Private isMacroRunning As Boolean 在模块级别声明。最终代码可能如下所示： Option Explicit Private myRibbon As IRibbonUI Private isMacroRunning As Boolean #If Mac Then #If VBA7 Then Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr #Else Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long #End If #Else 'Windows 'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx #If VBA7 Then Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) #Else Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) #End If #End If Sub OnRibbonLoad(ByVal ribbon As IRibbonUI) Set SafeRibbon = ribbon End Sub '=============================================================================== 'Set/Get Ribbon object '=============================================================================== Private Property Set SafeRibbon(ByVal ribbonUI As IRibbonUI) Set myRibbon = ribbonUI Dim mustAvoidSaveDialog As Boolean mustAvoidSaveDialog = ThisWorkbook.IsAddin And ThisWorkbook.Saved BookItem(ThisWorkbook, "BookPtr") = CStr(ObjPtr(ThisWorkbook)) BookItem(ThisWorkbook, "RibbonPtr") = CStr(ObjPtr(myRibbon)) If mustAvoidSaveDialog Then ThisWorkbook.Saved = True End Property Public Property Get SafeRibbon() As IRibbonUI If myRibbon Is Nothing Then If BookItem(ThisWorkbook, "BookPtr") = CStr(ObjPtr(ThisWorkbook)) Then 'Restore ribbon #If Win64 Then Dim ptr As LongLong Const ptrSize As Long = 8 #Else Dim ptr As Long Const ptrSize As Long = 4 #End If Dim obj As Object ' ptr = Int(BookItem(ThisWorkbook, "RibbonPtr")) CopyMemory obj, ptr, ptrSize 'Unmanaged - reference not counted Set myRibbon = obj CopyMemory obj, 0, ptrSize 'Reference count not decremented End If End If Set SafeRibbon = myRibbon End Property Sub GetPressed(control As IRibbonControl, ByRef returnedVal) Dim lastIDPressed As String ' lastIDPressed = BookItem(ThisWorkbook, "lastIDPressed") returnedVal = (lastIDPressed = control.ID) If Len(lastIDPressed) > 0 Then AsyncMacro lastIDPressed End Sub Sub AnyButtonGotPressed(control As IRibbonControl, IsPressed) If Not IsPressed Then BookItem(ThisWorkbook, "lastIDPressed") = vbNullString Exit Sub End If ' BookItem(ThisWorkbook, "lastIDPressed") = control.ID If Not isMacroRunning Then AsyncMacro control.ID End Sub Private Sub AsyncMacro(ByVal ctrlID As String) Application.OnTime Now(), CallbackName("AsyncMacroCallback", ctrlID) End Sub Private Function CallbackName(ByVal funcName As String, ByVal ctrlID As String) As String CallbackName = "'" & Replace(ThisWorkbook.Name, "'", "''") _ & "'!'" & funcName & " """ & ctrlID & """'" End Function Public Sub AsyncMacroCallback(Optional ByVal ctrlID As String) isMacroRunning = True Select Case ctrlID Case "customButton1": FirstMacro ctrlID Case "customButton2": SecondMacro ctrlID Case "customButton3": ThirdMacro ctrlID Case Else '... End Select BookItem(ThisWorkbook, ctrlID) = CStr(False) SafeRibbon.InvalidateControl ctrlID isMacroRunning = False End Sub Sub FirstMacro(ButtonName As String) Debug.Print "Enter macro 1 " & Now On Error GoTo CleanExit Do While BookItem(ThisWorkbook, "lastIDPressed") = ButtonName With ThisWorkbook.Sheets(1) .Range("A1").Select If ActiveCell.Address <> .Range("A1") Then 'Here comes stuff to do with the cell, if the user clicks somewhere out of "A1" End If DoEvents End With Loop CleanExit: Debug.Print "Exit macro 1 " & Now End Sub Sub SecondMacro(ButtonName As String) Debug.Print "Enter macro 2 " & Now On Error GoTo CleanExit Do While BookItem(ThisWorkbook, "lastIDPressed") = ButtonName With ThisWorkbook.Sheets(1) .Range("B2").Select If ActiveCell.Address <> .Range("B2") Then 'Here comes stuff to do with the cell, if the user clicks somewhere out of "B2" End If DoEvents End With Loop CleanExit: Debug.Print "Exit macro 2 " & Now End Sub Sub ThirdMacro(ButtonName As String) Debug.Print "Enter macro 3 " & Now On Error GoTo CleanExit Do While BookItem(ThisWorkbook, "lastIDPressed") = ButtonName With ThisWorkbook.Sheets(1) .Range("C3").Select If ActiveCell.Address <> .Range("C3") Then 'Here comes stuff to do with the cell, if the user clicks somewhere out of "C3" End If DoEvents End With Loop CleanExit: Debug.Print "Enter macro 3 " & Now End Sub 请注意，实际的宏（第一、第二、第三）都不需要对 InvalidateControl 进行更多调用，并且我们也不需要在 InvalidateControl 方法中将所有控件循环到 AnyButtonGotPressed .

excel vba breakpoints ribbon togglebutton

回答 1 投票 0

字典键值改变时的数据断点

假设我有一本字典： var dict = 新字典(); 字典[“foo”] =“酒吧”; 字典[“abc”] =“def”; 有没有办法设置断点...

c# breakpoints

回答 1 投票 0

VSCode 无法检查 Typescript 调试器自动附加中的变量

我正在使用yarn在Typescript中开发一个项目，我在 Windows 上运行，vscode 连接到 WSL。（我已经运行 code . 打开我的项目）。我的项目直接位于我的 WSL 分区上。我有...

typescript breakpoints vscode-debugger

回答 1 投票 0

breakpoints 相关问题

最新问题