如何清除分组复选框？

Question

我需要清除分组表单控件复选框。

我复制一行并将其下移到下一行。
我使用

ClearContents

清除复制到 A、B 和 D 列新行中的文本。
这不会清除复制到 C 列和 E 列中的分组表单控件复选框。

我想清除新复制的行中的这些复选框，以便向用户呈现干净的行。

代码当前如何工作：
该代码与“添加新行”按钮相关联。用户提示要求用户输入要添加的新行的行号。
用户输入新行号，将第 14 行向下复制到第 15 行的示例

在新复制的行中，A、B 和 D 列的文本被清除：
显示从第 14 行复制到第 15 行的新行并清除 A、B 和 D 列

我希望清除此新行中 C 列和 E 列中的复选框。
正在复制它们并勾选复选框。这些复选框被分组，例如C 列复选框分为一组，E 列复选框分为另一组。

有没有办法定位行/列来清除复选框？

我想要的：

1. 将任何新代码添加到我在添加新行按钮代码下已有的代码。

2. 从第 15 行开始添加。第 14 行已填充（因为这将是一个模板）。其他工作表中的情况可能并非如此，因此希望我可以更新要在其他工作表中用作模板行的行。

3. 理想情况下，如果用户尝试复制第 14 行或以上行，则抛出错误。目前，如果用户选择第 14 行，它会复制我的标题行并再次插入：
   如果用户尝试复制第 14 行，则显示再次复制的标题

添加新行按钮代码：

Private Sub CommandButton1_Click()

    Dim rowNum As Long
    On Error Resume Next
    rowNum = Application.InputBox(Prompt:="Enter Row Number of New Row to Add:", _
        Title:="Add New Row", Type:=1)
    Rows(rowNum).Insert Shift:=xlDown
    If Err.Number > 0 Then GoTo errH
    
    Range("A" & rowNum - 1).Resize(, 1).Copy Range("A" & rowNum)
    Range("B" & rowNum - 1).Resize(, 1).Copy Range("B" & rowNum)
    Range("C" & rowNum - 1).Resize(, 1).Copy Range("C" & rowNum)
    Range("D" & rowNum - 1).Resize(, 1).Copy Range("D" & rowNum)
    Range("E" & rowNum - 1).Resize(, 1).Copy Range("E" & rowNum)
    Range("F" & rowNum - 1).Resize(, 1).Copy Range("F" & rowNum)
        
    Range("A" & rowNum - 0).ClearContents
    Range("B" & rowNum - 0).ClearContents
    Range("D" & rowNum - 0).ClearContents

errH:
End Sub

我在网上查看了不同的代码，但大多数似乎都取消选中工作表上的所有复选框。

ClearContents

不针对表单控件复选框。

Clear

删除了列/行的底层格式，这是我不想要的。

我重新调整了我在here找到的代码。

我目前正在尝试：

' New Code:
' NOTE: Not sure how to link this to the CommandButton1_Click(1) below...
Sub setFormCheckboxes(ws As Worksheet, row As Long, value As Boolean)
    Dim cb As CheckBox
    For Each cb In ws.CheckBoxes
        If cb.TopLeftCell.row = row Then cb.value = value
    Next
End Sub

' Original Code + new code to Copy Row and Set Form Control Checknoxes to False
Private Sub CommandButton1_Click()
    
    Dim rowNum As Long
    On Error Resume Next
    
    ' User prompt to ask user to enter the row number of the next blank row, so the previous row is shifted/copied down
    rowNum = Application.InputBox(Prompt:="Enter the row number of the blank row below your last entry:", _
        Title:="Add New Row", Type:=1)
    Rows(rowNum).Insert Shift:=xlDown
    If Err.Number > 0 Then GoTo errH
      
    ' New Code: Copy Row from columns A-F
    ' NOTE: This is working well - thanks
    Range("A" & rowNum - 1).Resize(, 6).Copy Range("A" & rowNum)
    
    ' Clear text from columns A, B and D in newly copied row
    Range("A" & rowNum - 0).ClearContents
    Range("B" & rowNum - 0).ClearContents
    Range("D" & rowNum - 0).ClearContents
    
    ' New Code: Set Form Control Checkbxes to false
    ' NOTE: This isn't working to clear any of the checkboxes in my newly copied row yet...
    setFormCheckboxes ActiveSheet, rowNum, False
   
errH:
End Sub

尝试将 FunThomas 的代码与我自己的代码合并

Answer 1

您可以使用形状的

TopLeftCell

属性来识别复选框（基本上是任何形状）的行。

因此，您所要做的就是循环遍历工作表的所有复选框并检查该行。您只需要知道您使用的是表单控件还是 ActiveX 控件。如果您对此不熟悉，请查看Excel 表单控件与 ActiveX 控件之间的差异

对于表单控件，这相当简单，因为每个工作表都有一个

CheckBoxes

集合。以下例程设置或重置工作表行上的所有复选框：

Sub setFormCheckboxes(ws As Worksheet, row As Long, value As Boolean)
    Dim cb As CheckBox
    For Each cb In ws.CheckBoxes
        If cb.TopLeftCell.row = row Then cb.value = value
    Next
End Sub

对于 ActiveX 控件，不存在这样的集合，因此您需要循环遍历所有形状并检查是否有 ActiveX 复选框。

Sub setActiveXCheckboxes(ws As Worksheet, row As Long, value As Boolean)
    Dim cb As Shape
    For Each cb In ThisWorkbook.Sheets(2).Shapes
        If cb.Type = msoOLEControlObject Then
            If TypeName(cb.DrawingObject.Object) = "CheckBox" Then
                If cb.TopLeftCell.row = row Then cb.DrawingObject.Object.value = value
            End If
        End If
    Next
End Sub

顺便说一句：您可以一次复制该行的所有 (6) 个单元格：

' Copy row
Range("A" & rowNum - 1).Resize(, 6).Copy Range("A" & rowNum)
' Reset all checkBoxes, depending on which controls types you use:
setFormCheckboxes ActiveSheet, rowNum, False
setActiveXCheckboxes ActiveSheet, rowNum, True