通过VBA Command按钮使用组控件

Question

下午好，

我有一个工作簿，它有一个清除所有命令按钮，它将所有复选框和组合框重置为破折号，同时清除多个单元格。该工作簿还要求完成它的人使用excel中的墨水笔在底部签名。目前使用下面的代码它可以很好地工作，但是所有的activex控件都会随机调整大小。

调整大小问题的一个解决方案是将控件组合在一起;但是当我对它们进行分组并使用删除命令按钮时，它会删除所有控制对象。我想改变我的代码，所以当控件被分组时，它将从上面清除所有内容，但保持控件存在。

请记住，在VBA代码方面我非常基本

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

Answer 1

以下代码将存储ActiveX控件的原始大小，并将该大小重新应用于每个控件。

这应该可以解决调整大小的问题，我没有改变你的代码，因为正如你所说，它的效果很好而且我没有办法复制你的问题。

以下代码ActiveSheet已更改为Sheet(1)在更改时使用ActiveSheet不是一个好习惯。

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

如果您使用Debug.Print取消注释运行此代码，则可以在immediate window（ Ctrl + G 中查看形状的原始值启用）。如果您发现某些Objects不在此列表中，那么它们就不会被选中并调整大小。

有人说，在Excel表格中有ActiveX控制对象存在问题，您可以在Excel: the Incredible Shrinking and Expanding Controls和How to stop ActiveX objects automatically changing size in office? 中看到更多信息，其中包含更多有关如何尝试的选项并纠正这个对他人有用的问题。

（IMO）我倾向于使用Forms控件，这些控件更适用于Excel，并且不太容易出现某些错误和信任问题，而ActiveX控件是单独加载的。