VBA实战之：简易录入系统，通过窗体把数据写入表格

某日看到有贴如下：

图中看上去像个窗体的玩意儿来个清晰的：

于是我照葫芦画瓢搞了个相似的，如下：

在excel界面，开发工具-插入-ActiveX控件，即可绘制

具体插入哪些控件如下图：

VBA代码如下：

·工作表激活事件

Private Sub Worksheet_Activate()Sheet1.培训类型.ColumnCount = 2Sheet1.培训类型.ListFillRange = '培训人!E2:F4''Sheet1.培训人.ColumnCount = 2Sheet1.培训人.ListFillRange = '培训人!A2:A5''可以写成：Sheet1.培训人.List = Array('张仲景', '孙思邈')'不能写成：Sheet1.培训人.ListFillRange = 'Sheet2!A2:A5''不能写成：Sheet1.ComboBox1.RowSource = 'Sheet1!K1:K3'Sheet1.培训时长.List = Array('1.5小时', '2小时', '3小时')Sheet1.培训方式.ListFillRange = '培训人!B2:B3'Sheet1.培训形式.ListFillRange = '培训人!C2:C5'Sheet1.考核内容.ListFillRange = '培训人!D2:D5'
'年Sheet1.年.List = Array('2022')
'月Dim yue(1 To 12)For y_i = 1 To 12
yue(y_i) = y_i
Next
Sheet1.月.List = yue
'日Dim ri
If Int(Sheet1.月.Value) / 2 = 1 Then '如果是2月
ReDim ri(1 To 28)For r_i = 1 To 28ri(r_i) = r_iNextSheet1.日.List = ri
ElseIf Int(Sheet1.月.Value) / 2 = Int(Int(Sheet1.月.Value) / 2) And Int(Sheet1.月.Value) / 2 <> 1 Then '如果月份是偶数，且不是2月
ReDim ri(1 To 30)For r_i = 1 To 30ri(r_i) = r_iNextSheet1.日.List = ri
ElseIf Int(Sheet1.月.Value) / 2 <> Int(Int(Sheet1.月.Value) / 2) Then '如果月份是奇数
ReDim ri(1 To 31)For r_i = 1 To 31ri(r_i) = r_iNextSheet1.日.List = ri
End If
End Sub

·生成编号-点击事件

Private Sub 生成编号_Click()
'不清楚原帖里编号包含了哪些参数；本代码设置简单点，就用当前日期作为编号Sheet1.编号.Value = Format(Date, 'yyyymmdd')
End Sub

·培训内容-change事件

Private Sub 培训类型_Change()
Sheet1.培训类型2.Value = Sheet1.培训类型.List(Sheet1.培训类型.ListIndex, 1)
End Sub

·录入-点击事件

Private Sub 录入_Click()Dim box As OLEObject
bianhao = Sheet1.编号.Valuepeixun_lx = Sheet1.培训类型.Value & '·' & Sheet1.培训类型2.Value'peixun_lx = Sheet1.培训类型.List(0) & '·' & Sheet1.培训类型.List(1)peixun_nr = Sheet1.培训内容.Value
peixun_sj = Sheet1.年.Value & '/' & Sheet1.月.Value & '/' & Sheet1.日.Value
peixun_teacher = Sheet1.培训人.Valuepeixun_sc = Sheet1.培训时长.Valuepeixun_fs = Sheet1.培训方式.Valuepeixun_xs = Sheet1.培训形式.Valuekaohe_nr = Sheet1.考核内容.Value

'遍历受训人，新建各受训人的表单，并填入相应信息
For Each box In Sheet1.OLEObjects '遍历表中的OLEObject对象
If Left(box.Name, 8) = 'CheckBox' Then '判定控件是否是checkbox（复选框）
If box.Object.Value = True Then '如果此复选框已被勾选
Sheets.Add.Name = box.Object.Caption '则新增表单，以复选框的caption为名
With Sheets(box.Object.Caption)
.Cells(1, 1).Value = '编号'.Cells(1, 2).Value = '培训类型'.Cells(1, 3).Value = '培训内容'.Cells(1, 4).Value = '培训日期'.Cells(1, 5).Value = '培训人'.Cells(1, 6).Value = '培训时长'.Cells(1, 7).Value = '培训方式'.Cells(1, 8).Value = '培训形式'.Cells(1, 9).Value = '考核内容'
.Cells(2, 1).Value = bianhao.Cells(2, 2).Value = peixun_lx.Cells(2, 3).Value = peixun_nr.Cells(2, 4).Value = peixun_sj.Cells(2, 5).Value = peixun_teacher.Cells(2, 6).Value = peixun_sc.Cells(2, 7).Value = peixun_fs.Cells(2, 8).Value = peixun_xs.Cells(2, 9).Value = kaohe_nr
End With

End If
End If
Next
ThisWorkbook.Save

End Sub

运行后，效果如下：

涉及到的知识点

单选框和复选框一般结合框架使用，同一框架内的按钮自成一体，与其他框架内的按钮互不干扰。

now()函数，返回当前日期和时间（时分秒）；

date()函数，返回当前日期；

left函数，从指定字符串的左侧返回指定数量的字符

left(string,length)

OLEObjects 对象

是所有 OLEObject 对象的集合。

OLEObject对象代表一个ActiveX控件或者一个链接或嵌入的OLE对象?

texbox内编辑文字如何分行：

1，设置文本框Multiline  =  true

多行模式，true代表每行都有一个行首和行末

2，设置文本框Wordwarp  =  true

Wordwarp代表自动分行

3，设置文本框Enterkeybehavior=  true

不可使用 Text 更改 ComboBox 或 ListBox 中的条目的值；而是应使用 Column 或 List 属性。

最近在看《墨子》，预计用时1.5个月，看完夏已尽，寒冷的冬天又要来了。

上下班途中看的是《聊斋志异》。

END