本文于2023年5月19日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
☆本期内容概要☆
用户窗体设置：部门、人员、收费项目分类设置
Excel VBA 操作ACCESS数据库表，更新、删除、添加记录。
上期我们分享了【收费管理系统】收费项目设计【Excel VBA 收费项目/一步一步带你设计【收费管理系统】04】，本期我们将设计【部门、人员、收费项目分类】模块功能！
下面我们就开始：
1、首先在Access数据库中创建新表，重命名为“tb部门”。
2、创建新表，重命名为“tb人员”。
3、创建新表，重命名为“tb收费用项目分类”，用来规范收费项目编码。
4、打开VBA编辑器，在用户窗体Usf_Main上增加命令按钮CmdDepartment，Caption部门设置；CmdEmployee，Caption人员管理，CmdChargeType，Caption收费项目分类，可以通过复制“用户管理”命令按钮来完成，只要改一下名称、Caption，其他格式保持统一。
4、双击“部门设置”按钮，进入代码区，复制CmdUsers命令按钮的代码，把“tb用户”改为“tb部门”，就改这个地方，其他都不用改：
5、双击“人员管理”按钮，进入代码区，复制CmdUsers命令按钮的代码，把“tb用户”改为“tb人员”，同上，代码就不贴了，“收费项目分类”也同样操作。
6、增加、修改代码，代码量比较大，我们就挑重点来分析。本系列文章中的上一篇，我们设计了“收费项目”，但当时也只是搭了一个框架，代码没有优化，这两天我花了点时间，把它给补全了（基本补全吧，有些小细节方面可能还得慢慢雕琢），本次新增的几个表，相关代码也都写得差不多了，基本模式、套路差不多，我们就拿“收费项目”相关代码来分析吧：
（1）我们先进入编辑界面，分析一下需求：
这张表的字段比较多，如果新增加项目，全部都手工输入的话，一是工作量大，二是容易出错，为了避免上述两个不足，我们需要优化代码：
（A）控制项目代码规范：前两位代码必须来自“收费项目分类”，代码位数2位一级，代码必须是上级代码+2位本级代码
（B）其他项目根据代码进行自动填充，如项目全称=上级名称+“\”+项目名称等。
（C）可以选择输入的项目，通过双击单元格激活输入窗体，如
（2）我们来分析一下代码实现思路：
（A)新增加记录的，要求先输入项目代码，如果项目代码为空，则其他栏目不能输入：
If .ColumnHeaders(intCol) <> "项目代码" And .SelectedItem.SubItems(Pxy(tbTitle, "项目代码") - 1) = "" Then MsgBox "请先填写项目代码" InkEdit1.Width = 0 Exit SubEnd If
代码分析：判断点击的ListView表头，如果不是“项目代码”，而且“项目代码”为空的，则给出提示，退出过程。
（B)如果当前编辑栏目是“项目代码”的，检查编码前2位是否在“收费项目分类”表中：
If RecordValue(dataFile, "select count(项目分类) from tb收费项目分类 where 项目分类码='" & Left(InkEdit1.Text, 2) & "'") = 0 Then MsgBox "无此收费项目分类！" InkEdit1.Width = 0 Exit Sub
（C)新增项目，检查项目代码是否已存在，不能重复。
（D)如果判断都没有问题，则根据输入的项目代码，取得其他栏目的信息。
If Len(InkEdit1.Text) < 4 Or Len(InkEdit1.Text) Mod 2 <> 0 Then MsgBox "项目代码位数不合规则！请检查！" Me.InkEdit1.Text = "" Exit SubElseIf RecordValue(dataFile, "select count(项目代码) From tb收费项目 where 项目代码='" & InkEdit1.Text & "'") > 0 Then MsgBox "已存在项目代码，不能重复添加！" Me.InkEdit1.Text = "" Exit SubElse .SelectedItem.SubItems(intCol - 1) = InkEdit1.Text .SelectedItem.SubItems(Pxy(tbTitle, "是否末级") - 1) = "True" .SelectedItem.SubItems(Pxy(tbTitle, "使用状态") - 1) = "正常" .SelectedItem.SubItems(Pxy(tbTitle, "项目分类码") - 1) = Left(InkEdit1.Text, 2) .SelectedItem.SubItems(Pxy(tbTitle, "项目分类") - 1) = RecordValue(dataFile, "select 项目分类 from tb收费项目分类 where 项目分类码='" & Left(InkEdit1.Text, 2) & "'")End If'取得上级代码、上级名称等If Len(InkEdit1.Text) = 4 Then EditableField = "/项目名称/项目代码/使用状态/是否末级/" With Me.LvDetail For i = 1 To .ColumnHeaders.Count If InStr(EditableField, .ColumnHeaders(i)) Then EditableCol = EditableCol & Format(i, "00") & "/" End If Next End With .SelectedItem.SubItems(Pxy(tbTitle, "上级代码") - 1) = .SelectedItem.SubItems(Pxy(tbTitle, "项目分类码") - 1) .SelectedItem.SubItems(Pxy(tbTitle, "上级名称") - 1) = .SelectedItem.SubItems(Pxy(tbTitle, "项目分类") - 1)Else .SelectedItem.SubItems(Pxy(tbTitle, "上级代码") - 1) = Left(InkEdit1.Text, Len(InkEdit1.Text) - 2) If RecordValue(dataFile, "select count(项目名称) from tb收费项目 where 项目代码='" & Left(InkEdit1.Text, Len(InkEdit1.Text) - 2) & "'") Then .SelectedItem.SubItems(Pxy(tbTitle, "上级名称") - 1) = RecordValue(dataFile, "select 项目全称 from tb收费项目 where 项目代码='" _ & Left(InkEdit1.Text, Len(InkEdit1.Text) - 2) & "'") Else MsgBox "无此上级收费项目！" InkEdit1.Width = 0 Exit Sub End IfEnd If
代码分析：通过自定义函数Pxy取得表头字段位置，给相应的字段赋值，有些值需要到数据库表中查询，用到自定义函数RecordValue。
（E)对于修改已有记录的，判断逻辑同上，代码并不复杂，就是条件判断，这里就不多讲了，感兴趣的朋友可以看看第二条文章代码，它是InkEdit控件退出时，根据不同情况将其Text值赋值给对应ListView单元格的部分代码。
(F）对于另外几个表，tb用户、tb部门、tb人员、tb收费项目分类等，它们的代码跟tb收费项目差不多，甚至要简单一点，这里也不多讲。完整代码可以索要示例文件查看，这里实在是无法贴出来。
今天的内容就这么多，后面会继续，敬请关注！还请大家多多点赞、留言、分享，谢谢大家，我们下期再会。
☆猜你喜欢☆
本文使用 文章同步助手 同步，本文于2023年5月19日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！