将多个复选框中的数据添加到单元格

Question

我已经看到了与此类似的帖子，但我不确定100％如何使其适用于现有的UserForm。 我有5个复选框，如果选中，将向单元格中输入数据，包括是否选中了多个复选框。 因此，如果检查了HU和OS，它将读取类似HU，OS的内容。

现在的表格将信息添加到新行中，我希望它继续这样做。 我尝试了一些其他见过的方法，但它们似乎不适用于我的基本编码。 以下是表格和代码的屏幕截图。

编码：

Private Sub CommandButton1_Click()

Dim emptyRow As Long

'Make Sheet1 active
Sheet1.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
Cells(emptyRow, 1).Value = Position.Value
Cells(emptyRow, 2).Value = Time.Value
Cells(emptyRow, 3).Value = Callpriority.Value

If CellCB.Value = True Then Cells(emptyRow, 4).Value = Cells(emptyRow, 4).Value & "Yes"

Cells(emptyRow, 5).Value = Calltype.Value
Cells(emptyRow, 6).Value = Transferto.Value

If HUCB.Value = True Then Cells(emptyRow, 7).Value = HUCB.Caption

If OSCB.Value = True Then Cells(emptyRow, 7).Value = Cells(emptyRow, 7).Value & " " & OSCB.Caption

If CBCB.Value = True Then Cells(emptyRow, 7).Value = Cells(emptyRow, 7).Value & " " & CBCB.Caption

If SCCB.Value = True Then Cells(emptyRow, 7).Value = Cells(emptyRow, 7).Value & " " & SCCB.Caption

If TestCB.Value = True Then Cells(emptyRow, 7).Value = Cells(emptyRow, 7).Value & " " & TestCB.Caption

Cells(emptyRow, 8).Value = Code.Value
Cells(emptyRow, 9).Value = Phonenumber.Value
Cells(emptyRow, 10).Value = Comments.Value

ActiveWorkbook.Save

End Sub

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False
Unload Me
Testlog.Show
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton3_Click()

Unload Me

End Sub

Private Sub UserForm_Initialize()

'Fill Position
With Position
    .AddItem "Police A"
    .AddItem "Police B"
    .AddItem "Fire A"
    .AddItem "Fire B"
    .AddItem "Trainer"
    .AddItem "Supervisor"
End With

'Empty Time
Time.Value = ""

'Fill Callpriority
With Callpriority
    .AddItem "Non-Emergency"
    .AddItem "Emergency"
    .AddItem "Unknown"
End With

'Fill Calltype
With Calltype
    .AddItem "Police"
    .AddItem "Fire"
    .AddItem "Medical"
End With

'Empty Transferto
Transferto.Value = ""

'Uncheck DataCheckBoxes
HUCB.Value = False
OSCB.Value = False
CBCB.Value = False
SCCB.Value = False
TestCB.Value = False
CellCB.Value = False

'Fill Code
With Code
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
    .AddItem "4"
    .AddItem "5"
    .AddItem "6"
    .AddItem "7"
    .AddItem "8"
    .AddItem "9"
    .AddItem "10"
End With

'Empty Phonenumber
Phonenumber.Value = ""

'Empty Comments
Comments.Value = ""

End Sub

日志和表格

形成

Answer 1

只需添加一个String变量，然后根据需要向其添加文本。

Dim sDisposition As String

' ... Your other codes ...

sDisposition = ""
If HUCB.Value = True Then
    If Len(sDisposition) > 0 Then sDisposition = sDisposition & " "
    sDisposition = sDisposition & HUCB.Caption
End If
If OSCB.Value = True Then
    If Len(sDisposition) > 0 Then sDisposition = sDisposition & " "
    sDisposition = sDisposition & OSCB.Caption
End If
If CBCB.Value = True Then
    If Len(sDisposition) > 0 Then sDisposition = sDisposition & " "
    sDisposition = sDisposition & CBCB.Caption
End If
If SCCB.Value = True Then
    If Len(sDisposition) > 0 Then sDisposition = sDisposition & " "
    sDisposition = sDisposition & SCCB.Caption
End If
If TestCB.Value = True Then
    If Len(sDisposition) > 0 Then sDisposition = sDisposition & " "
    sDisposition = sDisposition & TestCB.Caption
End If
Cells(emptyRow, 7).Value = sDisposition ' typo here earlier...

' ... Your other codes ...

Answer 2

Dim sDisposition As String

Dim aaa As String
Dim bbb As String
Dim ccc As String
Dim ddd As String
Dim eee As String

aaa = ""
bbb = ""
ccc = ""
ddd = ""
eee = ""

If HUCB.Value Then aaa = HUCB.Caption        ' do not use   If true = true then ...
If OSCB.Value Then bbb = OSCB.Caption        ' just use     If true then ...
If CBCB.Value Then ccc = CBCB.Caption
If SCCB.Value Then ddd = SCCB.Caption
If TestCB.Value Then eee = TestCB.Caption

sDisposition = aaa & " " & bbb & " " & ccc & " " & ddd & " " & eee    ' concatenate string values

Cells(emptyRow, 7).Value = sDisposition

' or do not use sDisposition and do this
Cells(emptyRow, 7).Value = aaa & " " & bbb & " " & ccc & " " & ddd & " " & eee