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

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

Log and Form

Form

Answer 1

只需添加一个字符串变量并根据需要向其中添加文本。

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