excel - 命令按钮点击计数器，可调整​​并链接到形状

Question

我有一个将形状添加到工作表的命令按钮。每次按下 CommandButton 时，我都希望计数增加一。我还希望将此计数值应用于形状。例如，如果 CommandButton 已按下一次，我希望形状包含 text.character "1"，按下两次，我希望形状包含 text.character "2"，依此类推。

我还希望能够将计数器重置为特定值。例如，如果形状 #14 被删除并且命令按钮计数为 16，则需要将计数调整回 14，以便通过命令按钮创建另一个形状 #14。这也可用于将计数重置为 0。

本质上，我想要一个跟踪命令按钮点击次数的计数器。然后可以将此数字分配给全局变量，该变量稍后可以由计数器更新或由用户输入操作。

下面是与添加形状和 CommandButton 点击​​计数器相关的所有代码。

这是在 Sheet1 中:

Private Sub CommandButton2_Click() 'Add Shape to Picture, index click
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
CountWelds CommandButton2
Call ShapeWithNum
End Sub

以下内容都在一个模块中:
点击计数子

Option Explicit
Dim wb As Workbook
Dim ws As Worksheet
Public buttonCell As Range

Sub CountWelds(WeldControl As MSForms.CommandButton) 'Counter of clicks

  Set buttonCell = WeldControl.TopLeftCell
  buttonCell = buttonCell + 1
  buttonCell.Offset(0, 1).Value = buttonCell & " visitors from " & WeldControl.name & "."
End Sub

用户输入休息点击计数子

Sub Set_buttonCellCount()  'Set the counter to a specific value
    Dim answer As Long
    CountWelds ThisWorkbook.Sheets("Sheet1").CommandButton2
    answer = InputBox("Choose Weld Number  i.e. 1, 2, 3")
    buttonCell = answer
    MsgBox "Weld Number set to " & buttonCell + 1
End Sub

将形状添加到 Sheet1

Sub ShapeWithNum()  'Sub which adds the shape to sheet 1
    Dim weldw, weldl As Variant
    CountWelds ThisWorkbook.Sheets("Sheet1").CommandButton2
    If buttonCell < 10 Then
        weldw = 20
        weldl = 20
    Else
        weldw = 40
    w    eldl = 20
    End If

Index errors occur at each of the "Selection." locations. 

    ActiveSheet.Shapes.AddShape(msoShapeOval, 650, 100, weldw, weldl).Select
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = buttonCell
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 0). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignLeft
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .name = "+mn-lt"
    End With
    MsgBox buttonCell 'Used to see if the ButtonCell is indeed indexing

结束子

我让我的编码工作了一段时间，但随后开始出现:“运行时错误'-2147024809(80070057')指定集合的​​索引超出范围”错误。我不知道它为什么会发生。我已经在通常发生这种情况的代码中进行了评论。

每当我尝试从计数器 sub 以外的 sub 调用 buttonCell 时，我也会得到“未设置对象变量”。我尝试添加

'CountWelds ThisWorkbook.Sheets("Sheet1").CommandButton2

这似乎*修复它，但我不确定......

有什么建议么？

Answer 1

这是一个简单的例子，假设一个 ActiveX 按钮

Private Sub CommandButton1_Click()

Dim s As Shape, n As Long, s1 As Shape

For Each s1 In ActiveSheet.Shapes
    If s1.AutoShapeType = msoShapeOval Then n = n + 1
Next s1

n=n+1

Set s = ActiveSheet.Shapes.AddShape(msoShapeOval, 650, 100 + n * 50, 50, 50)
s.TextFrame.Characters.Text = n
s.TopLeftCell.Offset(1, 2).Value = "This is button press number " & n

End Sub