根据选中的复选框复制单元格值

Question

以下是我用来将旅行请求表格中的数据复制到travellog表格的代码：

    Sub Submit()

         Dim refTable As Variant, trans As Variant
         refTable = Array("B = L5", "C = C5", "D=G5", "E=C10", "F=C9", "G=I9", "H=I10",      "I=C13", "J=C14", "K=C15", "L=C16", "M=C17", "N=C18", "O=I13", "P=I14", "Q=I15", "R=I16", "S=I17", "W=H20")

 Dim Row As Long
    Row = Worksheets("TravelLog").UsedRange.Rows.Count + 1
    For Each trans In refTable
        Dim Dest As String, Field As String
        Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
        Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
        Worksheets("TravelLog").Range(Dest).Value = Worksheets("TravelRequest").Range(Field).Value
    Next

End Sub

现在我有3个单元格表示“是”，3个单元格表示“否”，每个单元格旁边都有一个activeX复选框。

当用户填写表格时，我希望能够复制复选框结果，所以如果用户选择了YES，NO，YES，那么我希望那些在下一张纸上进入3个单独的单元格。

因此，就像上面的代码一样，它需要被复制到一个包含其信息的新行中。

新更新的代码工作正常！

Sub Submit()

Dim refTable As Variant, trans As Variant
refTable = Array("B = L5", "C = C5", "D=G5", "E=C10", "F=C9", "G=I9", "H=I10", "I=C13", "J=C14", "K=C15", "L=C16", "M=C17", "N=C18", "O=I13", "P=I14", "Q=I15", "R=I16", "S=I17", "W=H20")
Dim Row As Long
Row = Worksheets("TravelLog").UsedRange.Rows.Count + 1

For Each trans In refTable
    Dim Dest As String, Field As String
    Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
    Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
    Worksheets("TravelLog").Range(Dest).Value = Worksheets("TravelRequest").Range(Field).Value
Next

If Worksheets("TravelRequest").CheckBox1.Value Then
    Worksheets("TravelLog").Range("T" & Row).Value = "Yes"
Else
    Worksheets("TravelLog").Range("T" & Row).Value = "No"
End If

If Worksheets("TravelRequest").CheckBox2.Value Then
    Worksheets("TravelLog").Range("U" & Row).Value = "Yes"
Else
    Worksheets("TravelLog").Range("U" & Row).Value = "No"
End If

If Worksheets("TravelRequest").CheckBox3.Value Then
    Worksheets("TravelLog").Range("V" & Row).Value = "Yes"
Else
    Worksheets("TravelLog").Range("V" & Row).Value = "No"
End If

End Sub

Answer 1

每个复选框都会自动命名为CheckBox#，其中#是创建它的编号。如果在“开发人员”选项卡中启用设计模式，则单击复选框。它会告诉您公式栏左侧的复选框的名称。您也可以在此处更改名称。

之后，您可以通过在For循环之前或之后立即执行此操作来确定是否已对其进行检查。

Worksheets("TravelLog").Range("T" & Row).Value = Worksheets("TravelRequest").DrewsCheckBox.Value

如果已选中，则T列中的单元格会显示True，如果未选中，则会显示False。如果您想在TravelLog工作表上说出True或False以外的其他内容，那么您可以这样做

If Worksheets("TravelRequest").DrewsCheckBox.Value Then
    Worksheets("TravelLog").Range("T" & Row).Value = "Yes"
Else
    Worksheets("TravelLog").Range("T" & Row).Value = "No"
End If