通过VBA命令按钮和组控件清除墨水。

8 浏览
0 Comments

通过VBA命令按钮和组控件清除墨水。

下午好,\n我有一个工作簿,其中有一个“清除全部”按钮,可以将所有复选框和组合框重置为破折号,并清除许多单元格。该工作簿还要求完成的人使用Excel中的墨水笔签名。目前,下面的代码运行良好,但所有的活动控件都会随机调整大小。\n解决调整大小问题的一个方法是将控件分组在一起;然而,当我将它们分组并使用删除按钮时,它会删除所有控件对象。我想修改我的代码,这样当控件被分组时,它将清除上面的所有内容但保留控件。\n请记住,我在VBA代码方面非常基础。\n下午好,\n我有一个工作簿,其中有一个\"清除全部\"按钮,可以将所有复选框和组合框重置为破折号,并清除许多单元格。该工作簿还要求完成的人使用Excel中的墨水笔签名。目前,下面的代码运行良好,但所有的活动控件都会随机调整大小。\n解决调整大小问题的一个方法是将控件分组在一起;然而,当我将它们分组并使用删除按钮时,它会删除所有控件对象。我想修改我的代码,这样当控件被分组时,它将清除上面的所有内容但保留控件。\n请记住,我在VBA代码方面非常基础。

0
0 Comments

问题的原因是在点击按钮后,部分对象的大小会发生变化。解决方法是存储原始的控件大小,并在每个控件上重新应用该大小。下面是解决问题的代码:

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激活)。如果你发现一些对象不在列表中,则表示它们没有被捕捉到并重新调整大小。

然而,使用Excel表格中的ActiveX控件对象存在一些问题,你可以在Excel: the Incredible Shrinking and Expanding ControlsHow to stop ActiveX objects automatically changing size in office?中找到更多关于如何解决自动调整大小问题的方法。

我个人更倾向于使用Excel中的Forms控件,它们更适用于Excel,并且不容易出现某些错误和信任问题,而ActiveX控件是单独加载的。

根据你提供的信息,当你在Excel中运行这段代码时,大部分控件的大小都正常,但有4个控件在每次点击按钮时会变小或移动。你可以通过在问题描述中附上屏幕截图来更新你的答案,这样我就能更好地理解问题是如何发生的。

最后,经过一些尝试,代码的最新版本似乎可以解决问题。如果仍然有问题,那可能是由于CommandButton1_Click之外的其他原因导致的。你可以在我的答案中找到更多关于其他人如何解决ActiveX对象大小调整问题的信息。如果最终无法解决,我很抱歉浪费了你的时间。

希望以上内容对你有所帮助!

0