|
☆本期内容概要☆ 本期内容信息量相当的大，内容涉及很多方面，请耐心阅读，肯定不会让你失望的！建议收藏！ Excel中记账凭证的打印，几种思路 Excel表记账的缺点
最新的打印方法：勾选凭证列表，点打印即可 Excel连接外部数据库（Excel文件）的方法 SQL语句查询Excel文件数据
循环打印的设计思路
我们前面分享过好几期“财务记账模板”相关内容，通过这么一个实例，向大家介绍Excel公式函数、VBA在财务管理中的运用，感兴趣的小伙伴可以翻翻前面的文章，这里我就不贴链接了。 今天我们要分享的主题是“凭证打印”，相信很多采用Excel来记账的财务小伙伴们肯定有这个困扰，凭证录进去了，怎么才能方便地把它打印出来呢？这个问题，我也是一路踩坑过来的：
后来觉得套打很麻烦，改为直接用空白的纸打印了，把凭证格式设计好即可。
上面两种方式都是手工操作，筛选一张打印一张，如果一号凭证分录超过6条，那么再切换到“凭证打印2”接着打印。如果凭证量较少，尚可应付，如果凭证量多就很累了。
于是，就开动脑筋，想想能不能我点一下按钮，它就自动打印我需要的凭证？就像各种商业财务软件一样？经过一番努力，还真搞出来一个可以自动打印的凭证模板，它是一个单独的文件，与我们的“Excel财务记账模板”（实际使用的名称是：XXX公司_20XX年序时账，并且文件名称中一定要包含“序时账”，以供打印模板更新链接之用）放在同一个目录下，感觉还是比较爽的：
上面这版打印模板通过power query查询数据，实现打印功能，同时也包含了不少VBA代码，但这不是今天的重点，我们不展开。
随着工作量的增加，这种Excel记账模板的局限性就越发明显：
2、数据安全性极低，表现在两个方面，一是Excel文件有时候会莫名其妙地打不开了，你就哭吧，二是在操作的时候，非常容易误操作把一些数据给改了、删了，造成极大的麻烦。于是我就下定决心，一定要搞一个“像样”的“财务管理系统”，以Excel为操作端，Access为数据存储端，以提高数据的安全性，操作的便利性。
经过大概3个多月的努力（平均到每天至少2-3个小时），终于开发完成，完全实现了一个小型财务软件所能有的功能。现在用起来不是一般的爽！有机会给大家介绍一下，现在分享的内容也有不少是来自这个“财务管理系统”。怎么看起来像打广告的？您先别急，就说到今天的重点了。
废话不多说了，我们试着打印一张凭证，把它打印到pdf文件中：
上面这个凭证打印的功能，就是移植自我的“财务管理系统”，当然经过了不少修改。我们下面介绍一下实现的思路： 1、我们在“明细账”表中增加一个命令按钮CmdVoucherPrint，把其Caption改为“凭证打印”。修改、增加了几个字段（减少修改代码的工作量）2、增加一个用户窗体Usf_VoucherList，我是通过复制来的：
其中有很多其他按钮，在打印的时候是不显示的，我也没有把它删掉，代码也保留着，说不定后面还会用到，就这么着吧。 增加一张工作表vPrint，用于打印凭证内容，也是复制来的： 
3、我们点击明细账中的“凭证按钮，启动Usf_VoucherList。
4、Usf_VoucherList启动时，读取明细账凭证数据到数组，我们这里采用的是SQL查询方式。 5、在这之前，我们需要定义几个自定义函数，不定义也行，直接在各个过程里写代码。但是，这几段代码可能会在很多地方用到，所以先定义一下： '自定义函数，取得【文件扩展名】Function GetExtn(iName) '获取文件后缀名 GetExtn = Right(iName, Len(iName) - InStrRev(iName, ".") + 1)End Function
代码解析：利用InStrRev函数，定位最右边一个“.”的位置，再结合Len、Right函数取得文件扩展名'自定义函数，取得【数据库连接字符串】Function GetStrCnn(ByVal DbFile As String, Optional ByVal Psw As String = "") Dim sType$ sType = GetExtn(DbFile) If InStr(sType, "accdb") Then GetStrCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=" & Psw & ";Data Source=" & DbFile ElseIf InStr(sType, "xl") Then GetStrCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & DbFile End IfEnd Function
代码解析：根据不同的文件类型，确定不同的连接字符串，我们这里主要是连接Excel文件。对于连接access数据库的情况下，如果有密码的，我们还要把密码赋值给psw。 '自定义函数，取得【数据库查询结果的记录数据】Function GetData(DataFile, sql) On Error Resume Next Dim cnn As Object '数据库连接 Dim rs As Object '记录集对象 Dim StrCnn As String '连接语句 Dim aData() Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") On Error Resume Next StrCnn = GetStrCnn(DataFile) '取得连接字符串 cnn.Open StrCnn '打开数据库链接 Set rs = cnn.Execute(sql) '执行查询，并将结果输出到记录集对象 GetData = rs.getrows '将记录输出到数组 rs.Close cnn.Close Set cnn = Nothing Set rs = NothingEnd Function
代码解析：根据数据库文件，SQL语句，查询数据，将结果存到数组里，详见代码注释。 '自定义函数，取得【数据库查询结果的表头字段】Function GetFields(DataFile, sql) Dim cnn As Object '数据库连接 Dim rs As Object '记录集对象 Dim StrCnn As String '连接语句 Dim aData() Dim FieldsNum As Integer Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") StrCnn = GetStrCnn(DataFile) '取得连接字符串 cnn.Open StrCnn '打开数据库链接 Set rs = cnn.Execute(sql) '执行查询，并将结果输出到记录集对象 FieldsNum = rs.Fields.Count '字段数量 ReDim aData(FieldsNum - 1) For i = 0 To FieldsNum - 1 '循环，把字段存入数组 aData(i) = rs.Fields(i).Name Next GetFields = aData rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd Function
代码解析：根据数据库文件，SQL语句，查询数据，将表头字段存到数组里，详见代码注释。 '自定义函数，【数字转大写人民币】Function N2RMB(m) Y = Int(Round(100 * Abs(m)) / 100) j = Round(100 * Abs(m) + 0.00001) - Y * 100 f = (j / 10 - Int(j / 10)) * 10 a = IIf(Y < 1, "", Application.Text(Y, "[DBNum2]") & "元") b = IIf(j > 9.5, Application.Text(Int(j / 10), "[DBNum2]") & "角", IIf(Y < 1, "", IIf(f > 1, "零", ""))) c = IIf(f < 1, "整", Application.Text(Round(f, 0), "[DBNum2]") & "分") N2RMB = IIf(Abs(m) < 0.005, "", IIf(m < 0, "负" & a & b & c, a & b & c))End Function
代码解析：这个函数是网上抄来的，利用Text(nummber,"[DBNum2]")把数字转成中文大写。 Function ColorByName(colorName As String) As Long'这个函数是根据颜色名称来取得颜色值代码较多，前面也分享过这里就不贴了。有兴趣的同学可以点下面链接查看。也可以不用这个函数，直接给出代码值。
6、窗体启动后，我们看到： 
几个按钮的功能我在图里标示，这里我们分析一下代码： （1）全选 Private Sub CmdSelectAll_Click() With Me.LvVoucherList If Me.CmdSelectAll.Caption = "全选" Then For i = 1 To .ListItems.Count .ListItems(i).Checked = True Next Me.CmdSelectAll.Caption = "全消" Me.CmdSelectAll.BackColor = RGB(176, 224, 230)
Else For i = 1 To .ListItems.Count .ListItems(i).Checked = False Next Me.CmdSelectAll.Caption = "全选" Me.CmdSelectAll.BackColor = RGB(143, 188, 143)
End If End WithEnd Sub
点击一次，在“全选”，“全消”之间切换，同时改变控件的名称与颜色 （2）月份右边向上、向下箭头，用来切换月份： Private Sub CmdUp_Click() With Me.CmbMonth For i = 0 To .ListCount - 1 If .Text = .List(i) Then j = i Exit For End If Next If j = 0 Then .Text = .List(.ListCount - 1) Else .Text = .List(j - 1) End If End With Me.CmdSelectAll.Caption = "全选" Me.CmdSelectAll.BackColor = RGB(143, 188, 143) Me.LvDetail.ListItems.ClearEnd SubPrivate Sub CmdDown_Click() With Me.CmbMonth For i = .ListCount - 1 To 0 Step -1 If .Text = .List(i) Then j = i Exit For End If Next If j = .ListCount - 1 Then .Text = .List(0) Else .Text = .List(j + 1) End If End With Me.CmdSelectAll.Caption = "全选" Me.CmdSelectAll.BackColor = RGB(143, 188, 143) Me.LvDetail.ListItems.ClearEnd Sub
代码解析：点击一次，me.cmbmonth的listindex增减1，遇到list开头再向上，则返回结尾，遇到结尾再向下则回到开头。原来是简单地在“20XX01~20XX12”之间循环，但是遇到某些月份没有数据就不好办了，要么报错，如果用On Error Resume Next则显示空白的列表，不爽。（3）窗体启动代码：Private Sub UserForm_Activate()，代码较长，我贴到第二条文章，下面的解释是AI贡献的，我也懒得去写了，将就着看吧：1. 声明变量：声明一个对象变量DicMonth，一个ListItem变量LvItem，一个字符串数组sData，以及其他一些变量。2. 设置用户表单的一些属性：设置CmdUp、CmdDown按钮的高度、顶部和左边位置，设置用户表单的标题、背景颜色等。4. 设置一些控件的属性：设置LbTitle、CmdSelectAll、CmdPrint等控件的属性。5. 定义SQL查询语句：定义三个SQL查询语句，用于从明细账表中获取数据。6. 获取数据：使用GetData函数从工作簿中获取数据，并将结果存储在aData变量中。7. 获取字段名：使用GetFields函数从工作簿中获取字段名，并将结果存储在sTbtitle变量中。8. 设置ListView控件的列头：根据字段名设置LvVoucherList和LvDetail控件的列头。9. 设置ListView控件的属性：设置LvDetail和LvVoucherList控件的显示外观、表格线、排序、复选框等属性。10. 遍历数据：遍历aData中的数据，将月份信息添加到字典对象DicMonth中。11. 设置ComboBox控件的属性：将字典对象DicMonth的键值作为CmbMonth控件的列表项，并设置控件的样式和默认选中项。12. 清空ListView控件的列表项：清空LvVoucherList控件的列表项。13. 添加列表项：根据选中的月份，将符合条件的数据添加到LvVoucherList控件的列表项中。14. 获取明细账表的字段名：使用GetFields函数从工作簿中获取明细账表的字段名，并将结果存储在tbTitle变量中。15. 设置ListView控件的列头：根据明细账表的字段名设置LvDetail控件的列头。总结：这段代码主要是在激活用户表单时，对表单中的一些控件进行设置，包括按钮的位置、大小，表单的标题、背景颜色等。同时，从工作簿中获取数据，并将数据添加到ListView控件中，以便用户查看和操作。通过设置ComboBox控件，可以让用户选择不同的月份，从而显示对应月份的数据。整个过程涉及到了一些Excel VBA编程的基本操作，如声明变量、定义SQL查询语句、获取数据、设置控件属性等。（4）打印：Private Sub CmdPrint_Click()，代码较长，我也把它贴到第二条文章，下面的解释也是AI贡献的，基本能说明问题：1. 定义所需的变量，如日期、凭证号、数组等。 2. 检查是否已选择打印机，如果没有，则退出子程序。 3. 关闭屏幕更新和警报，以提高性能。 4. 激活名为"vPrint"的工作表，并使其可见。 5. 获取用户选择的月份和已勾选的凭证号。 6. 如果没有勾选任何凭证，弹出提示框并退出子程序。 7. 根据勾选的凭证号，从名为"明细账"的工作表中获取相关数据。 8. 获取数据表的字段名，并确定各字段在数组中的位置。 9. 根据凭证号对数据进行分组，并计算每组的行数。 10. 遍历每个凭证，将其数据填充到"vPrint"工作表中。 11. 设置单元格格式，如数字格式、合计大写金额等。 12. 打印工作表，并在打印完成后等待1秒。 13. 计算总页数，并在打印完所有凭证后弹出提示框。 14. 卸载当前窗体，并激活名为"明细账"的工作表。 整个过程中，代码会不断读取和操作Excel工作表中的数据，以实现凭证的打印功能。 1、获取需要打印的凭证的凭证号，存到数组arrNumber里，也就是我们窗体中列表勾选的记录。2、根据月份、arrNumber，从明细账中查询数据，存到arrSelected sql = " select * from [明细账$] where 月份='" & iMonth & "' and 凭证号 in (" & numberStr & ")"arrSelected = GetData(myDataFile, sql)
这里的numberStr来自前面的数组arrNumber numberStr = Join(arrNumber, "','") numberStr = "'" & numberStr & "'"
这里值得注意的是，numberStr作为SQL语句的条件，要注意类型的匹配。如果是整数数值，那么直接numberStr = Join(arrNumber, ",")就好，如果是文本，那要加上单引号，如上面两行所示。
3、重设arrNumber，取得每个凭证的分录数： sql = "select 凭证号,count(凭证号) as 分录数 from (" & sql & ") group by 凭证号" arrNumber = GetData(myDataFile, sql)
这里的SQL从面前的SQL中再次查询“凭证号”、“分录数”，再存到数组arrNumber中，这里也可以使用另一个数组，但定义的太多也容易乱。 4、循环arrNumber，根据凭证号从arrSelected中提取一个凭证号的记录，存到数组arrPrint中，然后再把arrPrint数据写入工作表vPrint 5、这里要处理凭证分录多于6条的情况，就是第3条的意义所在。 iPage = Application.WorksheetFunction.RoundUp(iRow / 6, 0)
循环1 to ipage ，每6条分录打印一次，凭证号相应设置成“记-001,2/2”格式： .Cells(5, 7) = arrPrint(0, PosNumber) & "," & i & "/" & iPage
6、这里的细节有很多，不再细说了，有机会再分别讲吧。感兴趣的可以仔细分析一下代码。 另外，由于明细账表头字段修改，“科目汇总”代码也做了修改。对于双击汇总科目展示明细记录的代码，修改了LvDetail的字段宽度，根据明细账单元格的宽度来确定（arrWidthDetail）： With Sheets("明细账") For i = 1 To iCol If Cells(1, i) <> "" Then ReDim Preserve arrWidthDetail(i - 1) arrWidthDetail(i - 1) = Cells(1, i).Width End If Next End With
原来是这样的： arrWidthDetail = Array(60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60)
由于明细账字段增加，它的元素个数都不够用了，报错。索性改了吧。
|
