本文于2023年5月21日首发于本人同名公众号:Excel活学活用,更多文章案例请搜索关注!
☆本期内容概要☆
- 用户窗体设置:收费结算模块设置(上)
- Excel VBA 操作ACCESS数据库表,更新、删除、添加记录。
- 数组赋值给Combox控件的List
- 用透明标签覆盖文本框限制修改
上期我们分享了【收费管理系统】部门、人员等项目的设计【Excel VBA 部门、人员、收费项目分类设置/一步一步带你设计【收费管理系统】05】,本期我们将设计【收费结算】模块功能!由于该模块功能相对复杂,今天只能完成一部分。
下面我们就开始:
1、首先在Access数据库中创建新表,重命名为“tb收费明细”。
该表用于存放收费明细数据,所以是非常重要的一张表。这里我先手工增加一条记录。(注:字段后面有修改,图就不更新了。)
2、打开VBA编辑器,在用户窗体Usf_Main上增加命令按钮CmdCollection,Caption收费结算。
3、双击“收费设置”按钮,进入代码区,复制CmdUsers命令按钮的代码,把“tb用户”改为“tb收费明细”:
(注:代码后面有修改、图也不更新了。)
4、修改窗体“Usf_AddAndModify”启动代码,
(1)初始设置部分:
ElseIf currTable = "tb收费明细" Then
initSQL = "select top 1 * from " & currTable
arrWidth = Array(40, 0, 0, 0, 0, 0, 0, 200, 120, 80, 0, 200, 60, 60, 60, 60)
Me.LbTitle = "收费结算单"
EditableField = "All"
strRequiredField = "All"
Else
代码简析:
(A)SQL语句,这里只选1条记录,因为收费明细项目我们主要是增加新记录,不需要查询所有已存在的记录,这里选1条记录,是为了取得tb收费明细表的字段名称。
(B)arrWidth,字段宽度,有些设为0,在ListView中我们就看不到(实际上是可以看到的,拖动ListView表头即可显示,为了使得Listview的表头不能随便拖动,我采用了一个替代方法:
(2)针对“tb收费明细”设置数组aData():
If currTable = "tb收费明细" Then
ReDim aData(0 To UBound(tbTitle, 1) - 1, 0 To 5)
'把金额预填0
For i = 0 To UBound(aData, 2)
aData(Pxy(tbTitle, "金额") - 1, i) = Format(0, "Standard")
Next
Else
If RecordValue(dataFile, "select count(*) from " & currTable) > 0 Then
aData = GetData(dataFile, initSQL)
End If
End If
代码简析:如果是tb收费明细,我们把数组直接定义为6条空记录,把金额预填0。因为收费结算时,我们需要的是录入新记录,不需要修改旧记录。
(3)针对“tb收费明细”设置部分控件的属性,这里我们增加了一个Frame1(其实它一直都在,只是在操作其他表的时候,它是隐藏的,在操作tb收费明细时,需要它显示出来。),上面加了一些标签控件、文本框控件、复合框控件等,具体就不列了,参见前图。
(4)针对“tb收费明细”,增加了一些代码:
'取得最近日期,按日期降序排列,取最大,如果没有记录,则为当前日期
SQL = "Select top 1 日期 from tb收费明细 order by 日期 DESC"
If RecordValue(dataFile, "select count(*) from tb收费明细") > 0 Then
iDate = RecordValue(dataFile, SQL)
Else
iDate = Format(Date, "YYYY/MM/DD")
End If
.TxbDate = iDate
'取最大单号,加上1,为当前单号。如果没有记录,当前单号为1
'单号规则:字母D+日期(YYYYMMDD)+3位顺序号,即一天最多999号。
If VoucherProcType = "结算制单" Then
Dim preNumber As String
SQL = "Select top 1 单号 from tb收费明细 order by 单号 DESC"
If RecordValue(dataFile, "select count(*) from tb收费明细") > 0 Then
preNumber = RecordValue(dataFile, SQL)
If Mid(preNumber, 2, 8) = CStr(Format(iDate, "YYYYMMDD")) Then
.TxbNumber = Left(preNumber, 9) & Format(Right(preNumber, 3) + 1, "000")
Else
.TxbNumber = "D" & Format(iDate, "YYYYMMDD") & "001"
End If
'客户、渠道、医生、科目从数据库取出记录,作为复合框的List
arrCustomer = GetData(dataFile, "Select distinct 客户 from tb收费明细")
Me.CmbCustomer.List = arrCustomer
arrSource = GetData(dataFile, "Select distinct 渠道 from tb收费明细")
Me.CmbSource.List = arrSource
Me.CmbSource.Text = "无"
arrDoctor = GetData(dataFile, "Select distinct 医生 from tb收费明细")
Me.CmbDoctor.List = arrDoctor
arrDepartment = GetData(dataFile, "Select distinct 科室 from tb收费明细")
Me.CmbDepartment.List = arrDepartment
Else
.TxbNumber = "D" & Format(iDate, "YYYYMMDD") & "001"
Me.CmbSource = "无"
End If
Me.CmdVoucherProcess.Caption = "单据修改"
Else
Me.CmdVoucherProcess.Caption = "结算制单"
End If
'日期遮盖层,防止手工修改日期,造成日期格式不对,数据错误
'通过LbTopDate标签的双击事件,调用输入日期的窗体Usf_ChangeDate
With .LbTopDate
.Visible = True
.Top = Me.TxbDate.Top - 1
.Left = Me.TxbDate.Left - 1
.Width = Me.TxbDate.Width + 2
.Height = Me.TxbDate.Height + 2
.Caption = ""
.BackStyle = fmBackStyleTransparent
.ZOrder 0
End With
If VoucherProcType = "单据修改" Then
Me.CmdVoucherCopy.Caption = "修改"
Me.CmdVoucherCopy.ForeColor = vbRed
Me.TxbDate = ""
Me.TxbNumber = ""
Me.BackColor = RGB(204, 204, 255)
'.Frame1.BackColor = Usf_AddAndModify.BackColor
End If
代码解析:
(1)取得数据库中tb收费明细表的最大日期,赋值给TxbDate
(2)取得最大单号,加上1,赋值给TxbNumber。这里代码还有个单号中的日期与当前日期的比较,其实没必要,它们必然是相等的,时间关系暂时先这么着吧。后面再改。
(3)单号的规则是,字母D加上8位日期(YYYYMMDD),这里用Format函数转换格式,再加上3位顺序号。比如:D20230520001。
(4)客户、渠道、医生、科目从数据库取出记录,作为复合框的List,这里运用我们的自定义函数GetData(dataFile,SQL)。这些复合框如果没有可选择的,则可直接手工输入,相当于新增了。
(5)防止手工修改日期,在其上增加一层透明的标签。只有双击其上的标签、或者点左右的箭头才能修改。单号也类似,一般情况下单号不需要修改。
(6)这里有个public 变量VoucherProcType,凭证处理类型,作为区分是要新增记录(结算制单)还是要修改记录(单据修改)。看上去有点别扭,原因我在前期也说过,这个收费系统是参照我已经完成的一个小项目《财务管理系统》来的,用户窗体都是直接复制来的,代码也有很多复制成分。这里的“收费明细”对应那边的“凭证”。有些变量还是保持原样吧,省得改乱了。
(7)由于时间关系,还有一些需要完善的地方,比如“收费项目”的选择,日期的Change事件(影响单号),医生的Change事件(影响部门\科室)等,我们后期再做。
今天的内容就这么多,后面会继续,敬请关注!还请大家多多点赞、留言、分享,谢谢大家,我们下期再会!
☆猜你喜欢☆
【重磅】Excel VBA 应用分享/中医诊所收费系统/Excel+ListBox版 | Excel VBA 动态添加控件/学生成绩筛选 |
Excel VBA 这样酷炫的日期控件,你不想要吗? | Excel 公式函数/数据透视表/固定资产折旧计提表! |
Excel VBA 自定义函数/数组字段定位/数组字段排序 | Excel 功能/公式函数/VBA/多种姿势处理重复值 |
Excel VBA 最简单的收发存登记系统 | Excel 公式函数/查找函数之LOOKUP |
Excel VBA 文件批量改名 | Excel 公式函数/数据验证/动态下拉列表 |
Excel VBA 输入逐步提示/TextBox+ListBox | Excel 基础功能【数据验证】,你会怎么用? |
本文于2023年5月21日首发于本人同名公众号:Excel活学活用,更多文章案例请搜索关注!