Vba 如何计算和显示Excel加载项面板此加载项中包含的所有宏的使用总数

对不起。翻译与谷歌翻译！ 链接到程序开发人员的网站，我用它创建了文件Excel加载项！这个节目是免费的！ [

初始数据：我们有一个Excel程序的外接程序！外接程序由两个宏组成，它们与外接程序面板上的按钮关联

任务：汇总按钮上的所有按下次数。要在“附加组件”面板中显示的单击次数。重新启动后不应重置该次数

我无法解决的错误： 1如果选择“否”，则点击量将重置。2 每次启动Excel时，点击量增加2+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>

该变量的值随执行上下文的变化而变化；这意味着当End运行时，该值将消失。因此，您需要一个负责处理文件存储的过程。现在，您在Init_RibVar_Custom中有一些变量；将该文件处理问题移到其自己的过程中。见鬼，将整个计数器处理问题移到i中他们是自己的班级

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

现在，要保持正确计数，只需调用计数器。宏中的增量：

Sub macro1(control As IRibbonControl)
    counter.Increment
    '...
End Sub

请注意，Increment将调用SaveValue，因此无论发生什么情况，正确的值始终存储在文件中

---

只要确保LoadValue和SaveValue不改变值，您就可以始终拥有正确的计数。

感谢David Zemens和Mat的杯子

问题1的解决方案：在整个代码中删除结束运算符 问题2的解决方案：从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

---

解决方案非常简单：使用隐藏名称。此隐藏名称保存在工作簿中。若要创建隐藏名称并重新初始化计数器，请运行以下过程：

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>

这里的步骤是：

1当工作簿启动时，调用OnRibbonLoaded，其唯一目的是保持IRibbonUI变量

2当您按下humble按钮时，OnHumbleButtonClick回调将运行

4 OnHumbleButtonClick在计数器程序中运行，该程序：

4.1递增计数器

4.2使labelControl无效以反映新的计数器值无效使OnGetCounter运行以获取labelControl的新标签

作为补充说明，如果您使用功能区变量地址，最好添加可恢复该地址的代码。以下是所需添加的代码：

1创建隐藏名称以保留地址：

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

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

4帮助程序，用于检查功能区变量是否为nothing。如果为nothing，则将从隐藏名称还原地址：

Sub OnRibbonLoaded(IRibbon As IRibbonUI)
    Set ribbon = IRibbon
    ThisWorkbook.Names("RibbonPointer").Value = ObjPtr(ribbon)
End Sub

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

从现在起，您只需在使用ribbon变量之前调用CheckRibbon过程：

Sub MyProcedure
    ' Doing something...
    Call CheckRibbon
    ribbon.Invalidate
End Sub  

UPD：

若要将计数器与工作簿一起保存，您需要保存工作簿。对于普通工作簿，您可以手动保存，也可以在关闭工作簿时自动保存。对于加载项，您必须自动保存，因为关闭Excel时不会保存任何更改。若要自动保存，您需要使用工作簿的BeforeClose事件。转到此工作Book模块并粘贴此代码：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.Save
End Sub

---

无法编译。这不是有效的语句MsgBox First button，vbYesNo=vbNoThen@ThunderFrame.谢谢，修正了！现在还不清楚计数器的用途。你也应该回答你的问题，以明确问题所在。现在你描述了什么是错误的，但不是你期望的。在ribbon的onLoad中事件过程，您正在执行MyCounter=MyCounter+1，这将在重新启动时向MyCounter添加1，即使没有按下按钮。这是您所期望的吗？删除此行！

Sub MyProcedure
    ' Doing something...
    Call CheckRibbon
    ribbon.Invalidate
End Sub  

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.Save
End Sub