我已经看过一些与此类似的帖子,但我并不是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
答案 0 :(得分:0)
只需添加一个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 ...
答案 1 :(得分:0)
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