Sub to handle all ActiveX Control Changes, vba-CodePudding

I'm trying to clean up my spaghetti into a single sub that will handle all checkbox change event on a worksheet. It helps me consolidate the changes to one sub for changes when we adjust rates, it looks better, and looks more professional (my hope).

This is the functioning code block that I have copied 15 checkbox change events:

Private Sub ChkDetailStnd_Change()
    FastON
    With Me.TxtDetail
        If .Enabled = True Then
            Me.ChkDetailStnd.value = True
            .Enabled = False
            .Locked = False
            .BackStyle = fmBackStyleOpaque
            .BackColor = &HE0E0E0
            .value = 10
        Else
            Me.ChkDetailStnd.value = False
            .Enabled = True
            .Locked = True
            .BackStyle = fmBackStyleTransparent
            .BackColor = &HFFFFFF
        End If
    End With
    FastOFF
End Sub

This is what I am trying to get working by cycling through the controls on the worksheet. I am getting errors in how I refer to the control in the with statement and then changing the checkbox value.

Sub SumPgChk(ChkName As String) 
    
    Dim ctrl As OLEObject
    Dim ctrls As OLEObjects
    Dim i As String
    Dim TxtName As String
    Dim dict As New Dictionary
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Summary Page")

   
    dict.Add Key:="TxtB10", item:=15
    dict.Add Key:="TxtB15", item:=15
    dict.Add Key:="TxtB20", item:=15
    dict.Add Key:="TxtB25", item:=15
    dict.Add Key:="TxtB30", item:=15
    dict.Add Key:="TxtB35", item:=15
    dict.Add Key:="TxtB45", item:=15
    dict.Add Key:="TxtB55", item:=15
    dict.Add Key:="TxtAdmin", item:=5
    dict.Add Key:="TxtDetail", item:=10
    dict.Add Key:="TxtDelivery", item:=5
    dict.Add Key:="TxtMarkup", item:=5
    dict.Add Key:="TxtInstall", item:=5
    
    
    For Each ctrl In ws.OLEObjects
        If ctrl.name = ChkName Then
            TxtName = Mid(ChkName, 4, Len(ChkName) - 7)
            TxtName = "Txt" & TxtName
            With ctrls(TxtName)
                If .Enabled = True Then
                    ActiveSheet.OLEObjects(ChkName).Object.value = True
                    .Enabled = False
                    .Locked = False
                    .BackStyle = fmBackStyleOpaque
                    .BackColor = &HE0E0E0
                    .value = dict(TxtName)
                Else
                    ctrl(ChkName).Object.value = False
                     .Enabled = True
                     .Locked = True
                     .BackStyle = fmBackStyleTransparent
                     .BackColor = &HFFFFFF
                End If
            End With
        End If
    Next ctrl
    
    Set dict = Nothing
    
End Sub

I've tried addressing the checkboxes a few different ways based on a few forums and Microsoft directly. Any help would really be appreciated.

CodePudding user response：

It's easier to pass the checkbox object to the Sub and not its name.

You can do it something like this (I used a simpler control name mapping from checkbox to textbox - eg "ChkDetailStnd1" >> "TxtDetailStnd1":

Private Sub ChkDetailStnd1_Change()
    SumPgChk ChkDetailStnd1
End Sub

Private Sub ChkDetailStnd2_Click()
    SumPgChk ChkDetailStnd2
End Sub

Private Sub ChkDetailStnd3_Click()
    SumPgChk ChkDetailStnd3
End Sub

Private Sub ChkDetailStnd4_Click()
    SumPgChk ChkDetailStnd4
End Sub

Sub SumPgChk(chk As Object)
    
    Dim ws As Worksheet
    Dim TxtName As String, txtBox As Object
    
    Set ws = chk.Parent                         'sheet hosting the checkbox
    TxtName = Replace(chk.Name, "Chk", "Txt")   'map to matching textbox name
    
    Set txtBox = CallByName(ws, TxtName, VbGet) 'access a control by its name
    Debug.Print "Got " & txtBox.Name
    
    With txtBox
        .Enabled = chk.Value     'set according to checkbox value
        .Locked = Not .Enabled
        'I may have these back-to-front...
        .BackStyle = IIf(.Enabled, fmBackStyleOpaque, fmBackStyleTransparent)
        .BackColor = IIf(.Enabled, &HE0E0E0, &HFFFFFF)
    
        If .Enabled Then 'setting a value?
            Select Case TxtName
                Case "TxtDetailStnd1", "TxtDetailStnd3"
                    .Value = 10
                Case "TxtDetailStnd2", "TxtDetailStnd4"
                    .Value = 20
            End Select
        Else
            .Value = "" '?
        End If
    End With
End Sub

CodePudding user response：

So you want to go with "more professional"

What you can do is create a little class "CheckText" with all the logic of the interaction between the CheckBox and the TextBox. The class holds a reference to a CheckBox and a TextBox

Option Explicit
Private WithEvents m_chkBox As MSForms.CheckBox
Private WithEvents m_textBox As MSForms.TextBox

It has a function to link the sheet objects to the class

Public Function Link(chkBox As MSForms.CheckBox, txtBox As MSForms.TextBox)
    Set m_chkBox = chkBox
    Set m_textBox = txtBox
End Function

And for sure it holds your change logic on the checkbox.

Private Sub m_chkBox_Change()
    
    Debug.Print m_chkBox.Caption

    With m_textBox
        If m_chkBox.Value Then
            'm_chkBox.Value = True
            .Enabled = False
            .Locked = True
            .BackStyle = fmBackStyleOpaque
            .BackColor = &HE0E0E0
            .Value = 10
        Else
            'm_chkBox.Value = False
            .Enabled = True
            .Locked = False
            .BackStyle = fmBackStyleTransparent
            .BackColor = &HFFFFFF
        End If
    End With

End Sub

To ensure we have linked the text and checkboxes, the last we need is to add the code on workbook open to link all objects. All is held together by a collection of CheckText objects which you can use when enhancing your code base.

Option Explicit

Private m_CheckColl As Collection

Private Sub Workbook_Open()
    Dim ws As Worksheet: Set ws = Worksheets(1)
    
    Dim oneOle As OLEObject
    Dim oneCheck As MSForms.CheckBox
    Dim txtName As String
    
    Set m_CheckColl = New Collection
    
    For Each oneOle In ws.OLEObjects
        If TypeName(oneOle.Object) = "CheckBox" Then
            Set oneCheck = oneOle.Object
            txtName = Mid(oneOle.Name, 9, Len(oneOle.Name) - 8)
            txtName = "TextBox" & txtName
            
            Dim oneChkTxt As CheckText
            Set oneChkTxt = New CheckText
            oneChkTxt.Link oneCheck, ws.OLEObjects(txtName).Object
            m_CheckColl.Add oneChkTxt
        End If
    
    Next
    
End Sub

Now, the beauty is that you have access to all other event of the checkbox and the textbox in the class itself like:

No extra coding needed and the change events of the individual checkboxes stay empty:

Private Sub CheckBox1_Change()
End Sub

If they need to perform special tasks you can do so without polluting the "common base"