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
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
Which seems* to fix it, but I’m not sure…
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