基于 CheckBox True/False 复制的用户窗体命令按钮

Question

您好，我是 Excel VBA 新手，遇到以下问题，

我的工作簿有 sheet1 = Chandler_Endorsements（包含启动 UserForm1 的按钮）。我的用户窗体有 26 个 CheckBox 和 2 个 CommandButton（复制和重置）。

每个 CheckBox 都与工作簿中 sheet2 中的一个单元格相关联。每个后续单元格都有一个值，例如。特定格式的 ABc、XYz 等。

我的目标是让用户检查他们想要选择的每个项目的复选框，然后选择“复制”（CommandButton1），然后他们可以将它们粘贴到 Word 文件中。 例如。如果他们选中了复选框 1 和 2，则与这些复选框关联的单元格会被选中并复制，然后它们会粘贴到 word 文件中。

此外，如果用户稍后取消选择该单元格之间的复选框，则应选择并复制该单元格。

我使用以下代码为每个复选框赋予价值：

Private Sub CheckBox1_Click()
CheckBox1.Caption = Range("A3").Value
End Sub

Private Sub CheckBox10_Click()
CheckBox10.Caption = Range("A14").Value
End Sub

并且，为了应对相关单元格，我使用以下代码：

If CheckBox1.Value = True Then
    ActiveSheet.Range("A3").Copy
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Else: CheckBox1.Value = False
  End If

  If CheckBox2.Value = True Then
    ActiveSheet.Range("A4").Copy
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    Else: CheckBox2.Value = False
  End If

但是通过使用上面的代码，它并不能处理我选择的每个单元格（选中复选框）。请帮助我输入正确的代码。

Answer 1

这里建议以不同的方式进行：

• 此代码逐步遍历UserForm 中的每个Control
• 检查它是否为CheckBox
• 验证其.Value = True
• 它将数据存储到String
• 将CheckBox.Value 设置为False
• 将String 数据传输到剪贴板

Option Explicit

Sub TestRun()
Dim cCont As Control
Dim StrCopy As String
Dim IntI As Long
Dim Mydata As New DataObject

IntI = 1

For Each cCont In UserForm1.Controls

If TypeName(cCont) = "CheckBox" Then
    If cCont.Value = True Then
        StrCopy = StrCopy & Chr(10) & ActiveSheet.Range("B" & IntI).Value
        cCont.Value = False
    End If
IntI = IntI + 1
End If
Next cCont

Mydata.SetText StrCopy
Mydata.PutInClipboard
End Sub

Answer 2

试试这个...您可以应用自动打开而不是单击工作表 1 中的命令按钮。

检查并记录用户同时选择和复制单元格的复选框。然后，用户可以手动粘贴到word文件中。

Sub auto_open()
UserForm1.Show
Call Copy
End Sub


Sub Copy()
Dim SelectRange as String
SelectRange = ""

If UserForm1.CheckBox1.Value = True Then
    SelectRange = SelectRange + "," + "A3"
End If
If UserForm1.CheckBox2.Value = True Then
    SelectRange = SelectRange + "," + "A4"
End If
'So AS, checkbox3,4,5.......

If SelectRange <> "" Then
    SelectRange = Mid(SelectRange, 2, Len(SelectRange))
    Sheets("sheet2").Range(SelectRange).Select
    Selection.copy
End If

UserForm1.CheckBox1.Value = False
UserForm1.CheckBox2.Value = False
'So AS, checkbox3,4,5.......

End Sub