版权声明:本文为博主原创文章,未经博主允许不得转载。 https://blog.csdn.net/fourSeasonBeans/article/details/83151915
系统:Windows 7
软件:Excel 2010 / Access 2010
- 这个系列开展一个新的篇章,主体使用Access,包括数据库部分及界面部分,当然输出部分也会涉及到Excel,Excel的可读性还是比较好的
- 本公众号的不同阶段:Excel -> Excel + Access -> Access。但并不表示Access就一定比Excel好啊,各有所长吧,合适才是最好的
- 主体框架:换一种讲解方式,以项目为基础,从开始到结束
- 项目名称:培训管理系统
- 主要功能:两个界面。界面1,培训时录入信息;界面2,以培训老师和培训学员为客户,输出信息
- 涉及知识:Access界面,数据库知识,VBA,SQL,Excel
Part 1:本篇目标
- 输出所有老师的上课记录
- 每份档案生成一个Excel文件,命名方式:
所有老师上课记录_2018-10-14.xlsx
,其中日期为生成档案当天的日期 - Excel中只含有一个工作表,名称为:
老师上课记录
- 工作表中有四列:培训课程名称,培训开始时间,培训多少小时,培训老师
- 每份档案生成一个Excel文件,命名方式:
输出文件
对应数据库中原信息
操作界面
Part 2:逻辑过程
- 从数据库获取想要的信息,Recordset
- 将数据写入Excel
Part 3:代码
- 在窗体中增加一个事件
- 调用模块内的过程
窗体内代码
Private Sub 全部上课记录_Click()
Call sMod_sc_05_所有上课记录
End Sub
模块内代码
Sub sMod_sc_05_所有上课记录()
Rem>>
Rem>>
Dim SQL
Dim mode
Dim dbAddr
Dim rsAdConn
Dim rs
Dim adConn
Dim rsCount
' 第1步:从数据库中获取信息
SQL = "Select 培训课程名称,培训开始时间,培训多少小时,培训老师 From 02_培训课程"
mode = 2
dbAddr = fMod_dz_01_数据库地址
rsAdConn = fMod_tyk_01_rs产生(dbAddr, SQL, mode)
Set rs = rsAdConn(0)
Set adConn = rsAdConn(1)
rsCount = rs.RecordCount
If rsCount < 1 Then
MsgBox "无上课记录"
Exit Sub
End If
' 第2步:将rs写入Excel中
Dim rootAddress
Dim shijian
Dim teacherExcelName
Dim teacherExcelAddress
rootAddress = fMod_dz_02_输出文件地址()
shijian = Format(Now(), "yyyy-mm-dd")
teacherExcelName = "所有老师上课记录_" & shijian & ".xlsx"
teacherExcelAddress = rootAddress & "\" & teacherExcelName
If Dir(teacherExcelAddress) <> "" Then
Kill teacherExcelAddress
End If
'新建Excel文件
Dim exl As New Excel.Application
Dim wb As Excel.Workbook
Dim shtTemp As Excel.Worksheet
DoCmd.SetWarnings False
exl.Workbooks.Add
exl.ActiveWorkbook.SaveAs FileName:=teacherExcelAddress, FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Set wb = exl.ActiveWorkbook
Set shtTemp = wb.Worksheets(1)
shtTemp.Name = "老师上课记录"
Dim sh
For Each sh In wb.Worksheets
If (sh.Name <> "老师上课记录") Then
sh.Delete
End If
Next
'字段名称维护到输出文件
Dim fildNum
Dim j
Dim fildName
fildNum = rs.Fields.Count
For j = 0 To fildNum - 1 Step 1
fildName = rs.Fields(j).Name
shtTemp.Cells(1, j + 1) = fildName
Next j
shtTemp.Cells(2, 1).CopyFromRecordset rs
shtTemp.Cells.EntireColumn.AutoFit
'关闭数据库连接
adConn.Close
Set adConn = Nothing
'保存工作簿
wb.Save
wb.Close
exl.Quit
MsgBox "所有老师上课记录已导出:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) _
& teacherExcelAddress
End Sub
代码截图
Part 4:代码解读
- 本篇代码和上两篇基本一致,只是输出的内容变化一下,即SQL语句出做了一些修改
- 判断rs中是否有信息
rsCount = rs.RecordCount
If rsCount < 1 Then
MsgBox "无上课记录"
Exit Sub
End If
- 本文为原创作品,如需转载,可加小编微信号
learningBin
更多精彩,请关注微信公众号
扫描二维码,关注本公众号