Sheet CommandButton (ActiveX) Reset to Avoid Resize Issue

[breynolds0431]

I have a sheet that includes multiple sign off buttons. My initial problem was that the buttons would resize and move on the sheet. I found a solution over at stackoverflow that seems to do the trick. However, depending on the number of buttons that are on a sheet, the sub can take a considerable amount of time to complete as it needs to go through each button. I'm wondering if this can be made into a function and run on the button clicked rather than loop through all the sheet buttons.

Here is the code that calls the Shared_ObjectReset routine after a button is clicked:

Private Sub cbC1AL1_Click()

Call pubvariables

If modu.Range("PROV").value = 0 Then
    MsgBox "Error! " & vbCrLf & vbCrLf & "Signoff not allowed as there is nothing selected." _
        , vbCritical, "Make a Selection"
    Call Shared_ObjectReset
    Exit Sub
End If

If cbC1AL1.BackColor = vbRed Then
Else
    If Left(cbC1AL1.Caption, 7) = user Then 'user is in pubvariables as Environ("username")
        Dim ans As Integer
        ans = MsgBox("Would you like to undo the current signoff?", vbYesNo, "Signoff Options")
            If ans = vbYes Then
                With cbC1AL1
                    .BackColor = &HFFFFFF
                    .Font.Bold = False
                    .Height = 30
                    .Height = 24
                    .ForeColor = &H464646
                    .Caption = "SIGN"
                End With
                Call Shared_ObjectReset
                Exit Sub
            End If
    End If
End If

If Left(cbC1AL2.Caption, 7) = user Then 'This checks another button that a supervisor would use to validate the first signoff
    MsgBox "Error! " & vbCrLf & vbCrLf & "You cannot signoff as both the L1 and L2." _
        , vbCritical, "Unable to Sign"
Else 'If not the same person, the button changes colors and records user and date in button's caption
    With cbC1AL1
        .Caption = user & " " & Format(Date, "m/d/yy")
        .BackColor = &H996500
        .ForeColor = vbWhite
        .Font.Bold = True
    End With
    Call UpdateSigList 'Maintains a history of signoffs
End If

Call Shared_ObjectReset

End Sub

Original credit for this goes to user6645884 from the above stackoverflow link. Not sure what the rules are here for posting this, but the post was from 2016.

Sub Shared_ObjectReset()

Dim MyShapes As OLEObjects
Dim ObjectSelected As OLEObject
Dim ObjectSelected_Height As Double
Dim ObjectSelected_Top As Double
Dim ObjectSelected_Left As Double
Dim ObjectSelected_Width As Double
Dim ObjectSelected_FontSize As Single

ActiveWindow.Zoom = 90

'OLE Programmatic Identifiers for Commandbuttons = Forms.CommandButton.1
Set MyShapes = ActiveSheet.OLEObjects
For Each ObjectSelected In MyShapes
    'Remove this line if fixing active object other than buttons
    If ObjectSelected.progID = "Forms.CommandButton.1" Then
        ObjectSelected_Height = ObjectSelected.Height
        ObjectSelected_Top = ObjectSelected.Top
        ObjectSelected_Left = ObjectSelected.Left
        ObjectSelected_Width = ObjectSelected.Width
        ObjectSelected_FontSize = ObjectSelected.Object.FontSize

        ObjectSelected.Placement = 3

        ObjectSelected.Height = ObjectSelected_Height + 1
        ObjectSelected.Top = ObjectSelected_Top + 1
        ObjectSelected.Left = ObjectSelected_Left + 1
        ObjectSelected.Width = ObjectSelected_Width + 1
        ObjectSelected.Object.FontSize = ObjectSelected_FontSize + 1

        ObjectSelected.Height = ObjectSelected_Height
        ObjectSelected.Top = ObjectSelected_Top
        ObjectSelected.Left = ObjectSelected_Left
        ObjectSelected.Width = ObjectSelected_Width
        ObjectSelected.Object.FontSize = ObjectSelected_FontSize

    End If
Next

'The below was added by me to circumvent another issue when rows are added
Dim obj As OLEObject
For Each obj In ActiveSheet.OLEObjects
    If TypeOf obj.Object Is MSForms.CommandButton Then
        obj.Placement = xlMove
    End If
Next
End Sub