准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

Hi,各位同学好!

前几天有个在读大学的Access学员提供了一个应用场景,他说他对祖国的传统文化很感兴趣,且颇有涉猎。他打算在大学创立一个国风社。

他需要一个系统,用以管理社团成员,但找别人做经济成本太高,且后期完善需求有巨大的时间和经济成本隐患,综合考虑,打算自己边学边做,自给自足。

在做录入社团报名人员窗体的时候,他遇到了一个Access的经典问题:报名表里有一个允许多选的查阅字段,在窗体里对应一个组合框控件,当组合框控件不绑定这个多值字段的时候,默认控件无法实现多选功能。

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

报名表中多值字段展示图

他需要能自由实现自定义效果的功能,不想使用控件绑定记录源字段的方式去实现组合框的多选。

虽然不精通但同样喜欢传统文化的我,必须鼎力相助。我为他做了一个自定义窗体的例子,实现了不绑定多值字段仍支持多选的组合框,且一并解决了多选组合框的值如何保存到表里的问题。

现将案例和实现方法都分享给大家,希望能帮助到有相似需求的同学,节省一些时间和精力。

示例效果图如下:

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

示例效果演示动态图

表结构和关系展示:

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

表关系展示图

窗体设计视图:

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

技艺类目窗体

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

社团报名入口窗体

VBA代码结构图:

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

VBA详细代码展示:

Form_国学技艺类目窗体内代码:

Option Compare Database
Option Explicit

'取消选择
Private Sub Btn_Cancel_Click()
Me.Parent.Form.擅长技艺.SetFocus
Me.Parent.Form.Child26.Visible = False
End Sub

'确定使用选择的值
Private Sub Btn_Ok_Click()
Me.Parent.Form.擅长技艺.SetFocus
'给擅长技艺赋值
getAllCheckedValue

Me.Parent.Form.Child26.Visible = False
End Sub

'窗体打开时初始化
Private Sub Form_Open(Cancel As Integer)

Dim ctl As Control
For Each ctl In Me.Controls
If (VBA.TypeName(ctl) = "CheckBox" Or VBA.TypeName(ctl) = "Label") Then
ctl.Visible = False
End If
Next ctl

Dim db As Database, rs As Recordset
Set db = Application.CurrentDb
Set rs = db.OpenRecordset("国学技艺类目", dbOpenDynaset, dbSeeChanges)
Dim i As Integer
If (Not (rs.BOF And rs.EOF)) Then
Do Until rs.EOF
i = i + 1
Dim cbx As CheckBox, cbxLabel As Label
Set cbx = Me.Controls("Check" & i)
cbx.DefaultValue = rs("ID").Value
Set cbxLabel = cbx.Controls(0)
Call intCbxValue(IIf(IsNull(Me.Parent.IDS), "", Me.Parent.IDS), cbx)
cbx.Value = False
cbxLabel.Caption = rs("名称")
cbxLabel.Visible = True
cbx.Visible = True
rs.MoveNext
Loop
End If

End Sub


'将选择的所有给主窗体的擅长技艺控件
Private Function getAllCheckedValue()
Dim ctl As Control
Dim IDS As String, names As String
For Each ctl In Me.Controls
If (VBA.TypeName(ctl) = "CheckBox") Then
If (ctl.Value = True) Then
IDS = IDS & "," & ctl.DefaultValue
names = names & "," & ctl.Controls(0).Caption
End If
End If
Next ctl

If (VBA.Len(IDS) > 0) Then
IDS = VBA.Mid(IDS, 2)
names = VBA.Mid(names, 2)
End If
Me.Parent.擅长技艺.Value = names
Me.Parent.IDS.Value = IDS
End Function

Form_国学社报名入口:

Option Compare Database
Option Explicit

'关闭窗体按钮
Private Sub Btn_Close_Click()
If (VBA.MsgBox("确定要退出吗?将会丢失未保存的值", vbOKCancel) = vbOK) Then
DoCmd.Close acForm, Me.name
End If
End Sub

'保存按钮
Private Sub Btn_save_Click()
Dim db As Database
Dim rs As Recordset, rs2 As Recordset2
Set db = Application.CurrentDb
Set rs = db.OpenRecordset("国学社报名表", dbOpenDynaset, dbSeeChanges)

On Error GoTo errorhandler:
rs.AddNew
rs("姓名") = Me.姓名
rs("性别") = Me.性别
rs("出生日期") = Me.出生日期
Set rs2 = rs("擅长技艺").Value
initMultiValueRs rs2, Me.IDS
rs.Update

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

MsgBox "保存成功"
resetControls

Exit Sub

errorhandler:
MsgBox "保存失败"

End Sub

'重置控件值
Private Function resetControls()
Me.姓名 = ""
Me.性别 = ""
Me.出生日期 = ""
Me.IDS = ""
Me.擅长技艺 = ""
End Function

'用ids控件结果填充rs2值
Private Function initMultiValueRs(rs2 As Recordset2, vals As String)
If (Not (rs2.BOF And rs2.EOF)) Then
'此if结构是为了使此方法适合编辑值时初始化,本案例中没有编辑记录操作,故用不上
Do Until rs2.BOF
rs2.MoveLast
rs2.Delete
Loop
End If

If (VBA.Len(vals) > 0) Then
'添加新值列表
Dim arr As Variant
arr = VBA.Split(vals, ",")
Dim i As Integer
For i = LBound(arr) To UBound(arr)
rs2.AddNew
rs2("value") = VBA.CLng(arr(i))
rs2.Update
Next i
End If

End Function

'窗体加载时隐藏子窗体控件
Private Sub Form_Load()
Me.Child26.Visible = False
End Sub

'双击打开多选框,且初始化多选框值
Private Sub 擅长技艺_DblClick(Cancel As Integer)
Me.Child26.Visible = True

Dim ctl As Control
For Each ctl In Me.Child26.Form.Controls
If (VBA.TypeName(ctl) = "CheckBox" And ctl.Visible = True) Then
Call intCbxValue(IIf(IsNull(Me.IDS), "", Me.IDS), ctl)
End If
Next ctl

End Sub

CommonFunction模块内代码:

Option Compare Database
Option Explicit


'初始化多选框的值
Public Function intCbxValue(IDS As String, cbx As CheckBox)

If (VBA.InStr(1, "," & IDS & ",", "," & cbx.DefaultValue & ",")) Then
cbx.Value = True
Else
cbx.Value = False
End If
End Function

重难点分析:

•  图中案例综合应用了:表设计、窗体设计、窗体事件、VBA编程等知识模块,只有掌握了这些知识,有了扎实的基础之后,才能更高效地自学和提升自己的Access水平;

•  多练习老师在课程里教授的查阅官网帮助文档的方法。目前国内网络上,关于Access编程的参考资料实在是太少;

•  官网帮助文档需要在有很好的基础上再去研究,普通人去看等同看天书。

上述技能在吴明老师的《Access零基础到应用系统教程》中均可学到。

可查看课程链接:​​《Access零基础到应用系统教程》​

该课程可以使学员以最少的学习时间,搭建完善的数据库和Access窗体编程知识架构。

准时下班系列!Access合集之第7集—自定义多选组合框和VBA处理多值字段实例

案例文档下载链接:

链接:https://pan.baidu.com/s/1lh6sh3XJvb6MRbQVz8Ss4g 

提取码:wmkt 

发表评论

相关文章