如何计算和显示Excel加载项面板此加载项中包含的所有macros的使用总数
抱歉。 翻译谷歌翻译！
链接到程序开发者的网站，我用它创build了Excel加载项文件！ 这个程序是免费的！ [ http://novikov.gq/products/ribbonxmleditor/ribbonxmleditor.html] [1 ]
初始数据：我们有一个程序Excel的插件！ 加载项包含两个与外接面板上的button关联的macros。
任务：总结button上的所有按键。 在“附件”面板上显示的点击量。 重新启动后，金额不应重置。
我无法解决的错误：
1）点击次数被重置，如果您select否（按下button2）
2）每次启动Excel时，点击数量都加1，这是不正确的。
XML代码：
<?xml version="1.0" standalone="yes"?> <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="Init_RibVar_Custom"> <ribbon startFromScratch="false"> <tabs> <tab id="excel-vba" label="Test"> <group id="groupe_1" label=" Редактирование"> <button id="button_1" imageMso="GoLtrDown" label="Button 1" onAction="macro1" /> <button id="button_2" imageMso="GoLtrDown" label="Button 2" onAction="macro2" /> </group> <group id="groupe_2" label="Counter"> <labelControl id="Counter" getLabel="getLabel_Cnt" /> </group> </tab> </tabs> </ribbon> </customUI> 主要代码：
Option Explicit #If VBA7 Then Public Declare PtrSafe Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As LongPtr) #Else Public Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As Long) #End If Public MyCounter As Long Public objRibCustom As IRibbonUI Public cntr As IRibbonControl Sub CheckRibbon() If objRibCustom Is Nothing Then #If VBA7 Then Dim lPointer As LongPtr lPointer = CLngPtr(ThisWorkbook.Sheets(1).Range("A1")) #Else Dim lPointer As Long lPointer = CLng(ThisWorkbook.Sheets(1).Range("A1")) #End If CopyMemory objRibCustom, lPointer, LenB(lPointer) End If End Sub Sub Init_RibVar_Custom(ribbon As IRibbonUI) Set objRibCustom = ribbon ThisWorkbook.Sheets(1).Range("A1") = ObjPtr(ribbon) objRibCustom.Invalidate Open "D:\Counter.txt" For Input As #1 Input #1, MyCounter Close #1 MyCounter = MyCounter + 1 Call getLabel_Cnt(cntr, "") Open "D:\Counter.txt" For Output As #1 Print #1, MyCounter Close #1 End Sub Sub getLabel_Cnt(control As IRibbonControl, ByRef label) Call CheckRibbon If cntr Is Nothing Then Set cntr = control End If label = "Counter: " & MyCounter On Error Resume Next objRibCustom.InvalidateControl control.ID objRibCustom.Invalidate End Sub Sub macro1(control As IRibbonControl) MyCounter = MyCounter + 1 Call getLabel_Cnt(cntr, "") MsgBox "First button", vbOKOnly End Sub Sub macro2(control As IRibbonControl) MyCounter = MyCounter + 1 Call getLabel_Cnt(cntr, "") If MsgBox("Second button ", vbYesNo) = vbYes Then Else End End If End Sub
Public MyCounter As Long
该variables的价值与执行上下文一起生存和消亡; 这意味着当End运行时，值不见了。 所以你需要一个负责处理文件存储的程序。 现在你在Init_RibVar_Custom有一些 将该文件处理问题转移到自己的程序中。 哎呀，把整个反处理的事情变成自己的阶级！
Option Explicit Private currentValue As Long Private Sub Class_Initialize() LoadValue End Sub Public Property Get Value() As Long Value = currentValue End Property Public Sub Increment() currentValue = currentValue + 1 SaveValue End Sub Public Sub LoadValue() 'assign currentValue from file End Sub Public Sub SaveValue() 'save currentValue to file End Sub
现在将这个类命名为CallCounter ，然后代替这个：
Private MyCounter As Long
你可以有这个：
Private counter As New CallCounter
现在，为了保持正确的计数，您只需要在macros中调用counter.Increment ：
Sub macro1(control As IRibbonControl) counter.Increment '... End Sub
请注意， Increment将调用SaveValue ，所以不pipe发生了什么，正确的值总是存储在文件中。
只要确保LoadValue和SaveValue不会更改该值，并且始终具有正确的计数。
感谢David Zemens和Mat的杯子
问题1的解决scheme：在整个代码中删除End操作符
问题2的解决scheme：从程序Init_RibVar_Custom中删除行MyCounter = MyCounter + 1
Option Explicit #If VBA7 Then Public Declare PtrSafe Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As LongPtr) #Else Public Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As Long) #End If Public MyCounter As Long Public objRibCustom As IRibbonUI Public cntr As IRibbonControl Sub CheckRibbon() If objRibCustom Is Nothing Then #If VBA7 Then Dim lPointer As LongPtr lPointer = CLngPtr(ThisWorkbook.Sheets(1).Range("A1")) #Else Dim lPointer As Long lPointer = CLng(ThisWorkbook.Sheets(1).Range("A1")) #End If CopyMemory objRibCustom, lPointer, LenB(lPointer) End If End Sub Sub Init_RibVar_Custom(ribbon As IRibbonUI) Set objRibCustom = ribbon ThisWorkbook.Sheets(1).Range("A1") = ObjPtr(ribbon) objRibCustom.Invalidate Open "D:\Counter.txt" For Input As #1 Input #1, MyCounter Close #1 Call getLabel_Cnt(cntr, "") Open "D:\Counter.txt" For Output As #1 Print #1, MyCounter Close #1 End Sub Sub getLabel_Cnt(control As IRibbonControl, ByRef label) Call CheckRibbon If cntr Is Nothing Then Set cntr = control End If label = "Counter: " & MyCounter On Error Resume Next objRibCustom.InvalidateControl control.ID objRibCustom.Invalidate End Sub Sub macro1(control As IRibbonControl) Open "D:\Counter.txt" For Input As #1 Input #1, MyCounter Close #1 MyCounter = MyCounter + 1 Call getLabel_Cnt(cntr, "") MsgBox "First button", vbOKOnly Open "D:\Counter.txt" For Output As #1 Print #1, MyCounter Close #1 End Sub Sub macro2(control As IRibbonControl) Open "D:\Counter.txt" For Input As #1 Input #1, MyCounter Close #1 MyCounter = MyCounter + 1 Call getLabel_Cnt(cntr, "") If MsgBox("Second button ", vbYesNo) = vbYes Then Else End If Open "D:\Counter.txt" For Output As #1 Print #1, MyCounter Close #1 End Sub
解决方法非常简单：使用隐藏的名字。 这个隐藏的名字保存在工作簿中。 要创build隐藏的名称（还要重新初始化计数器），请运行以下过程：
Sub CreateHiddenName() ThisWorkbook.Names.Add Name:="ClicksCounter", RefersTo:=0, Visible:=False End Sub
隐藏的名字安全地保存在/xl/workbook.xml中：
<definedNames> <definedName name="ClicksCounter" hidden="1">0</definedName> </definedNames>
我使用的testing工作簿具有以下用于function区的XML：
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="OnRibbonLoaded"> <ribbon> <tabs> <tab id="rxTab1" label="MY_TAB"> <group id="rxGroup1" label="Group1"> <button id="rxButton1" label="I am humble button" imageMso="QueryAppend" onAction="OnHumbleButtonClick" /> <labelControl id="rxLabel1" getLabel="OnGetCounter" /> </group> </tab> </tabs> </ribbon> </customUI>
VBA代码（在标准模块中）：
Private ribbon As IRibbonUI Sub OnRibbonLoaded(IRibbon As IRibbonUI) Set ribbon = IRibbon End Sub Sub OnGetCounter(ctrl As IRibbonControl, returnValue) returnValue = "Counter: " & GetCounterValue() End Sub Sub OnHumbleButtonClick(ctrl As IRibbonControl) ' Do something here... ' In the end call: Call IncrCounter End Sub Sub IncrCounter() ThisWorkbook.Names("ClicksCounter").Value = GetCounterValue() + 1 ribbon.InvalidateControl "rxLabel1" End Sub Function GetCounterValue() GetCounterValue = Replace(ThisWorkbook.Names("ClicksCounter").Value, "=", "") End Function
这里发生了什么：
1）当工作簿启动时， OnRibbonLoaded被调用，其唯一目的是保持IRibbonUIvariables。
2）当你按下“谦虚”button，运行OnHumbleButtonClickcallback。
4） OnHumbleButtonClick运行IncrCounter过程：
4.1）递增计数器;
4.2）使labelControl无效以反映新的计数器值（无效使OnGetCounter运行以获取labelControl的新标签）。
作为一个方面说明，最好是添加代码来恢复Ribbonvariables地址，当然，如果你使用它。 这里需要添加代码：
1）创build隐藏的名称，以保持地址：
Sub AddNameForRibbonPointer() ThisWorkbook.Names.Add Name:="RibbonPointer", RefersTo:=0, Visible:=False End Sub
2）声明恢复地址的Win32 RtlMoveMemory函数：
#If VBA7 Then Public Declare PtrSafe Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As LongPtr) #Else Public Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As Long) #End If
3）添加一个将隐藏的名字保持在地址栏的行：
Sub OnRibbonLoaded(IRibbon As IRibbonUI) Set ribbon = IRibbon ThisWorkbook.Names("RibbonPointer").Value = ObjPtr(ribbon) End Sub
4）帮助程序检查色带variables是否不是什么。 如果是，则会从隐藏的名称恢复地址：
Sub CheckRibbon() If ribbon Is Nothing Then #If VBA7 Then Dim lPointer As LongPtr lPointer = CLngPtr([RibbonPointer]) #Else Dim lPointer As Long lPointer = CLng([RibbonPointer]) #End If CopyMemory ribbon, lPointer, LenB(lPointer) End If End Sub
从现在起，您只需在使用Ribbonvariables之前调用CheckRibbon过程：
Sub MyProcedure ' Doing something... Call CheckRibbon ribbon.Invalidate End Sub
UPD：
为了与工作簿保持一致，您需要保存工作簿。 对于通常的工作簿，可以手动保存或在closures工作簿时自动执行。 对于加载项，您必须自动执行此操作，因为在closuresExcel时不会保存更改。 为了自动保存，您需要使用Workbook的BeforeClose事件。 转到ThisWorkbook模块并粘贴下面的代码：
Private Sub Workbook_BeforeClose(Cancel As Boolean) ThisWorkbook.Save End Sub