Clearing ink via VBA Commandbutton with group controls

Question

Good afternoon,

I have a workbook that has a clear all commandbutton which resets all the checkboxes and comboboxes back to dashes along with clearing numerous cells. This workbook also requests the person who completed it to sign the bottom using the ink pen in excel. Currently with the code below it works great however all of the activex controls randomly resize themselves.

One solution to the resizing issue is to group the controls together; however when I group them and use the delete commandbutton, it deletes all of the control objects. I would like to alter my code so when the controls are grouped it will clear everything from above but keep the controls present.

Please keep in mind I am very basic when it comes to VBA code

Private Sub CheckBox2_Click()
    Select Case ComboBox2.Value
        Case "1": ComboBox2.BackColor = RGB(255, 0, 0)
        Case "2": ComboBox2.BackColor = RGB(0, 255, 0)
        Case "3": ComboBox2.BackColor = RGB(0, 0, 255)
        Case Else: ComboBox2.BackColor = RGB(242, 247, 252)
    End Select
End Sub

Private Sub CheckBox3_Click()
    Select Case ComboBox3.Value
        Case "1": ComboBox3.BackColor = RGB(255, 0, 0)
        Case "2": ComboBox3.BackColor = RGB(0, 255, 0)
        Case "3": ComboBox3.BackColor = RGB(0, 0, 255)
        Case Else: ComboBox3.BackColor = RGB(242, 247, 252)
    End Select
End Sub


Private Sub ComboBox1_Change()
    Select Case ComboBox1.Value
        Case "1": ComboBox1.BackColor = RGB(255, 0, 0)
        Case "2": ComboBox1.BackColor = RGB(0, 255, 0)
        Case "3": ComboBox1.BackColor = RGB(0, 0, 255)
        Case Else: ComboBox1.BackColor = RGB(242, 247, 252)
    End Select
End Sub


Private Sub ComboBox4_Change()
    Select Case ComboBox4.Value
        Case "1": ComboBox4.BackColor = RGB(255, 0, 0)
        Case "2": ComboBox4.BackColor = RGB(0, 255, 0)
        Case "3": ComboBox4.BackColor = RGB(0, 0, 255)
        Case Else: ComboBox4.BackColor = RGB(242, 247, 252)
    End Select
End Sub

Private Sub ComboBox87_Change()
    Select Case ComboBox87.Value
        Case "1": ComboBox87.BackColor = RGB(255, 0, 0)
        Case "2": ComboBox87.BackColor = RGB(0, 255, 0)
        Case "3": ComboBox87.BackColor = RGB(0, 0, 255)
        Case Else: ComboBox87.BackColor = RGB(242, 247, 252)
    End Select
End Sub    

Private Sub CommandButton1_Click()
    ComboBox2.Text = "-"
    ComboBox3.Text = "-"
    ComboBox4.Text = "-"

    CheckBox1.Value = False
    CheckBox2.Value = False
    CheckBox3.Value = False
    CheckBox4.Value = False
    CheckBox5.Value = False
    CheckBox8.Value = False
    CheckBox9.Value = False
    CheckBox10.Value = False
    CheckBox11.Value = False

    Range("F9:F9").Value = 0
    Range("F11:F11").Value = 0
    Range("F14:F14").Value = 0
    Range("F16:F16").Value = 0
    Range("F19:F19").Value = 0
    Range("F21:F21").Value = 0
    Range("F24:F24").Value = 0
    Range("F26:F26").Value = 0
    Range("F32:F32").Value = 0
    Range("F34:F34").Value = 0
    Range("F36:F36").Value = 0
    Range("F42:F42").Value = 0
    Range("F44:F44").Value = 0
    Range("F52:F52").Value = 0
    Range("F54:F54").Value = 0
    Range("F56:F56").Value = 0
    Range("K32:K32").Value = 0
    Range("K34:K34").Value = 0
    Range("L42:L42").Value = 0
    Range("L44:L44").Value = 0
    Range("L52:L52").Value = 0
    Range("J9:M9").Value = "-"
    Range("J14:M14").Value = "-"
    Range("J19:M19").Value = "-"
    Range("J24:M24").Value = "-"

Dim Shp As Shape

For Each Shp In ActiveSheet.Shapes
    If Not (Shp.Type = msoOLEControlObject Or Shp.Type = msoFormControl Or 
Shp.Type = msoPicture) Then Shp.Delete
Next Shp

End Sub

Before After After-2 window error alert error in code

Miguel_Ryu · Accepted Answer · 2018-02-08T07:50:01.907

The below code will store the original size of your ActiveX controls and re-apply that size to each control.

This should solve the issue with the resizing, I didn't alter your code because, as you say, it works great and I have don't have a way to replicate your issue.

In the below code ActiveSheet as been changed to Sheet(1) It's not a good practice to utilize ActiveSheet in case of changes.

Private Sub CommandButton1_Click()

    Dim Shp As Shape

    'dim array that will store controls Height and Width
    Dim sizeArray As Variant

    'change Sheets(1) to your sheet, this can be done by number like below or name or like Sheets("Sheet1")

    'For Each Shp In ActiveSheet.Shapes
    For Each Shp In Sheets(1).Shapes
        If Not (Shp.Type = msoOLEControlObject Or Shp.Type = msoFormControl Or Shp.Type = msoPicture) Then
            Shp.Delete
        Else
            'Debug.Print Shp.Name & " [" & Shp.Height & ", " & Shp.Width & "] [" & Shp.Top & ", " & Shp.Left & "]"

            'resize array and store Shape (Name, Height, Width, Top Distance, Left Distance)
            If IsEmpty(sizeArray) Then
                ReDim sizeArray(0)
                sizeArray(0) = Array(Shp.Name, Shp.Height, Shp.Width, Shp.Top, Shp.Left)
            Else
                ReDim Preserve sizeArray(0 To UBound(sizeArray) + 1)
                sizeArray(UBound(sizeArray)) = Array(Shp.Name, Shp.Height, Shp.Width, Shp.Top, Shp.Left)
            End If
        End If
    Next Shp

    ' your code
    ComboBox2.text = "-"
    ComboBox3.text = "-"
    ComboBox4.text = "-"

    CheckBox1.Value = False
    CheckBox2.Value = False
    CheckBox3.Value = False
    CheckBox4.Value = False
    CheckBox5.Value = False
    CheckBox8.Value = False
    CheckBox9.Value = False
    CheckBox10.Value = False
    CheckBox11.Value = False

    With Sheets(1)
        .Range("F9:F9").Value = 0
        .Range("F11:F11").Value = 0
        .Range("F14:F14").Value = 0
        .Range("F16:F16").Value = 0
        .Range("F19:F19").Value = 0
        .Range("F21:F21").Value = 0
        .Range("F24:F24").Value = 0
        .Range("F26:F26").Value = 0
        .Range("F32:F32").Value = 0
        .Range("F34:F34").Value = 0
        .Range("F36:F36").Value = 0
        .Range("F42:F42").Value = 0
        .Range("F44:F44").Value = 0
        .Range("F52:F52").Value = 0
        .Range("F54:F54").Value = 0
        .Range("F56:F56").Value = 0
        .Range("K32:K32").Value = 0
        .Range("K34:K34").Value = 0
        .Range("L42:L42").Value = 0
        .Range("L44:L44").Value = 0
        .Range("L52:L52").Value = 0
        .Range("J9:M9").Value = "-"
        .Range("J14:M14").Value = "-"
        .Range("J19:M19").Value = "-"
        .Range("J24:M24").Value = "-"
    End With

    'for each shape return to original values
    'For Each Shp In ActiveSheet.Shapes
    For Each Shp In Sheets(1).Shapes
        'if shape is in array
        If InArrayIndex(Shp.Name, sizeArray) >= 0 Then
            'Debug.Print Shp.Name & " [" & Shp.Height & ", " & Shp.Width & "] [" & Shp.Top & ", " & Shp.Left & "]"

            'if shape Height, Width, Top and Left distances to original values
            Shp.Height = sizeArray(InArrayIndex(Shp.Name, sizeArray))(1)
            Shp.Width = sizeArray(InArrayIndex(Shp.Name, sizeArray))(2)
            Shp.Top = sizeArray(InArrayIndex(Shp.Name, sizeArray))(3)
            Shp.Left = sizeArray(InArrayIndex(Shp.Name, sizeArray))(4)
        End If
    Next Shp

    'try to specifically rectictify width of Shapes that are resizing
    With Sheets(1)
        'Shp.Name & " [" & Shp.Height & ", " & Shp.Width & "] [" & Shp.Top & ", " & Shp.Left & "]"
        'ComboBox87 [20.625, 64.87496] [12, 472.875]
        .Shapes("ComboBox87").Width = 64.87496

        'ComboBox2 [20.625, 54.74992] [60.37504, 473.2501]
        .Shapes("ComboBox2").Width = 54.74992

        'CheckBox1 [26.25, 35.62496] [619.5, 334.875]
        .Shapes("CheckBox1").Width = 35.62496

        'CheckBox3 [24.375, 37.12496] [645, 328.125]
        .Shapes("CheckBox3").Width = 37.12496
    End With
End Sub

Private Function InArrayIndex(val As String, arr As Variant) As Double
    'function returns Index of val(shape.name) in the supllied arr
    'default error retunr index of -1

    InArrayIndex = -1
    For n = LBound(arr) To UBound(arr)
        'if val matches arr
        If (arr(n)(0) = val) Then
            'return index in arr
            InArrayIndex = n
            'early function exit
            Exit Function
        End If
    Next
End Function

If you run this code with Debug.Print uncommented you can view the original values of the shapes in the immediate window (Ctrl+G to activate). If you see that some of your Objects are not in this list then they are not being picked up and resized.

That being said there are are problems with utelizing ActiveX control Objects in Excel Sheets, you can see more information in Excel: the Incredible Shrinking and Expanding Controls and How to stop ActiveX objects automatically changing size in office? , which will contain more options on how to try and rectify the issue, which has worked for others.

(IMO) I tend to do is to use Forms Controls, which are more specific to Excel and less prone to certain bugs and trust issues, while ActiveX Controls are loaded separately.

When I put the code into Excel it worked for the majority of controls on the sheet however there were 4 that got smaller or moved every time the button was pushed. — Guaca24, Feb 06 '18 at 12:13
@Guaca24 Can you update your answer with a before and after print screen of whats happening, because I'm struggling to see how/why that happens. — Miguel_Ryu, Feb 06 '18 at 12:24
You should [edit](https://stackoverflow.com/posts/48630707/edit) your question with the screenshots. — Miguel_Ryu, Feb 06 '18 at 15:19
@Guaca24, I've just edited my answer with `Top` and `Left` coordinates, that should solve the moving problem. — Miguel_Ryu, Feb 06 '18 at 18:49
Still affecting 4 boxes....the top two highlighted are shrinking from the right edge in to the left and the bottom two highlighted are expanding from the right edge further right. You can see this in the screenshot above -> (After-2) — Guaca24, Feb 07 '18 at 12:32
@Guaca24 - In the property setting of you Objects (Combo/CheckBoxs') is the AutoSize set to True? BTW Do you have code in the Objects? You seem to have more Objects in your image than you clean in your code. — Miguel_Ryu, Feb 07 '18 at 13:19
I have edited the other code I have on the sheet regarding the comboboxes. The code only details what background color they are. I have edited my initial code above. As far as them being set to AutoSize they are all set to False. — Guaca24, Feb 07 '18 at 13:23
@Guaca24, Which version of excel are you using? Are the Objects with the background colour change the ones that keep resizing? If so try this, write `"object".width = "object".width` the start of your button code. The `"object"` part is the `ComboBox1`/`2` etc. — Miguel_Ryu, Feb 07 '18 at 13:36
I am using Excel 2016 and all of my ComboBoxes have that background color, none of my checkboxes have color associated with them. Only two of my five ComboBoxes and two of my four checkboxes still resize after your latest code change. — Guaca24, Feb 07 '18 at 13:44
Ok, can you just ensure all Shapes are being recorded by running the below code and checking against your Object names. `For Each Shp In ActiveSheet.Shapes` `Debug.Print Shp.Name` `Next Shp` Did you try `"object".width = "object".width`? I was sure that would work on 2016 — Miguel_Ryu, Feb 07 '18 at 13:55
Sorry for not knowing where or how to run the code...still a beginner when it comes to VBA. Could you walk me through it? Thanks in advance — Guaca24, Feb 07 '18 at 14:45
ComboBox 87 and 2 are the ones that are contracting at the top and CheckBox 1 and 3 are the ones expanding at the bottom — Guaca24, Feb 07 '18 at 17:31
@Guaca24 Hi, I've just edited my answer with a hard reset on your shapes width, this should work. If it doesn't, it means that it's being caused by something out of the `CommandButton1_Click` scope. I've left some more information on my answer about many other people which have had problems with `ActiveX` Object and have file type solutions to the resizing issue. I'm sorry if in the end I couldn't solve and wasted your time with these tests. — Miguel_Ryu, Feb 08 '18 at 08:00
Its getting a runtime error. I posted the two screenshots of the error box and where the error is happening. — Guaca24, Feb 08 '18 at 14:44
@Guaca24, remove `.Shapes("ComboBox87")` and put only `.ComboBox87` instead. — Miguel_Ryu, Feb 08 '18 at 15:15
@Guaca24 If you remove `With Sheets(1)` and remove the `.` (dot) in `.ComboBox87.Width = 64.87496` — Miguel_Ryu, Feb 08 '18 at 16:09
Ok that seemed to work....thank you so much for all of your hard work! I def have a long way to go to understanding VBA! — Guaca24, Feb 08 '18 at 16:52
@Guaca24 No problem, here to help. Btw this one even let me feeling queasy ^^ — Miguel_Ryu, Feb 08 '18 at 16:54

Clearing ink via VBA Commandbutton with group controls

1 Answers1