Command Button click counter that is adjustable and links to shapes

Question

I have a CommandButton that adds shapes to a sheet. Each time the CommandButton is pressed, I want the count to index up by one. I also want this count value to be applied to the shape. For example, if the CommandButton has been pressed once, I want the shape to contain text.character "1", pressed twice, I want the shape to contain text.character "2" and so on.

I also would like to be able to reset the counter back to a specific value. For example, if shape #14 is deleted and CommandButton count is at 16, the count needs to be adjusted back to 14 so that another shape #14 created via the CommandButton. This could also be used to reset the count to 0.

Essentially, I'd like a counter which tracks the number of CommandButton clicks. This number can then be assigned to a global variable which can later be either updated by the counter or manipulated by user inputs.

Below is all the code that relates to the adding of shapes and a CommandButton click counter.

This is in 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

This following is all in one Module: Click Counting 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

User Input rest the Click Count 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

Add Shape to the 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

End Sub

I got my coding working for a bit, but then starting getting: "Run-time error '-2147024809 (80070057') The index into the specified collection is out of bounds" errors. I don't know why its occurring. I've commented in the code where this typically occurs.

I also get "Object variable not set" whenever I try and call buttonCell from a sub other than the counter sub.. I tried adding

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

Which seems* to fix it, but I'm not sure...

Any suggestions?

Answer 1

Here is a simple example, assuming an ActiveX button

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