Access-培训管理系统-13-输出个人培训档案

微信公众号原文

系统：Windows 7
软件：Excel 2010 / Access 2010

• 这个系列开展一个新的篇章，主体使用Access，包括数据库部分及界面部分，当然输出部分也会涉及到Excel，Excel的可读性还是比较好的
• 本公众号的不同阶段：Excel -> Excel + Access -> Access。但并不表示Access就一定比Excel好啊，各有所长吧，合适才是最好的
• 主体框架：换一种讲解方式，以项目为基础，从开始到结束
• 项目名称：培训管理系统
• 主要功能：两个界面。界面1，培训时录入信息；界面2，以培训老师和培训学员为客户，输出信息
• 涉及知识：Access界面，数据库知识，VBA，SQL，Excel

Part 1：本篇目标

1. 输出学员的个人培训档案
   • 每份档案生成一个Excel文件，命名方式：阿大_个人学习档案_2018-09-29.xlsx，其中日期为生成档案当天的日期
   • Excel中只含有一个工作表，名称为：个人培训档案
   • 工作表中有四列：培训课程名称，培训开始时间，培训多少小时，培训老师

输出文件

2.png

输出Excel里的内容

1.png

操作界面

5.png

**对应数据库内的内容
03_培训记录

4.png

02_培训课程

3.png

Part 2：逻辑过程

1. 检查学员姓名有无录入
2. 输出该学员对应学员档案
   • 从03_培训记录记录表中获取该学员对应的培训课程ID
   • 以上一步骤获取的培训课程ID去02_培训课程中查询对应信息
   • 输出信息至Excel表格

Part 3：代码

1. 在窗体中增加一个事件
2. 调用模块内的过程

窗体内代码

Private Sub 个人培训档案_Click()
    Dim frmName
    frmName = fFrm_pxsc_01_当前窗体名称
    
    arr = Array("学员姓名")
    check = fMod_tyk_02_是否全部填写检查(frmName, arr)
    
    studentName = Me.Controls("学员姓名")
    If check = True Then
        Call sMod_sc_03_个人学习档案输出(studentName)
    Else
        MsgBox "请输入学员姓名"
    End If
End Sub

代码截图

6.png

模块内代码

Sub sMod_sc_03_个人学习档案输出(studentName)
    Rem>>
    Rem>>
    Dim folderAddr
    Dim shijian
    Dim excelFileName
    Dim excelAddress
    
    folderAddr = fMod_dz_02_输出文件地址
    shijian = Format(Now(), "yyyy-mm-dd")
    excelFileName = studentName & "_个人学习档案_" & shijian & ".xlsx"
    
    excelAddress = folderAddr & "\" & excelFileName
    
    '检查文件是否存在
    If Dir(excelFileName) <> "" Then
        Kill excelAddress
    End If
    
    Dim tblTrainCourse
    Dim tblTrainPerson
    Dim tbl2Combine
    Dim searchCondition
    Dim searchC1
    Dim searchC2
    
    Dim mode
    Dim dbAddr
    Dim SQL
    Dim rsAdConn
    Dim rs
    Dim adConn
    
    tblTrainCourse = "02_培训课程"
    tblTrainPerson = "03_培训记录"
    
    searchC1 = "学员姓名=" & Chr(39) & studentName & Chr(39)
    SQL = "Select 培训课程ID From " & tblTrainPerson & " where(" & searchC1 & ")"
    mode = 2
    dbAddr = fMod_dz_01_数据库地址
    
    rsAdConn = fMod_tyk_01_rs产生(dbAddr, SQL, mode)
    
    Set rs = rsAdConn(0)
    Set adConn = rsAdConn(1)
    
    Dim ids
    Dim pxID
    
    ids = ""
    rs.MoveFirst
    For i = 0 To rs.RecordCount - 1
        pxID = rs.Fields(0).Value
        If ids = "" Then
            ids = pxID
        Else
            ids = ids & "," & pxID
        End If
        rs.MoveNext
    
    Next i
    
    rs.Close

    searchC2 = "培训课程ID in (" & ids & ")"
    
    SQL = "Select 培训课程名称,培训开始时间,培训多少小时,培训老师 From " & tblTrainCourse & " where " & searchC2 _
    & " order by 培训开始时间 ASC"
    
    mode = 2
    dbAddr = fMod_dz_01_数据库地址
    
    rsAdConn = fMod_tyk_01_rs产生(dbAddr, SQL, mode)
    
    Set rs = rsAdConn(0)
    Set adConn = rsAdConn(1)

    '新建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:=excelAddress, 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) _
    & excelAddress
    
End Sub

代码截图

7.png

8.png

9.png

Part 4：代码解读

1. 本篇代码较长，重点介绍如何在Access中通过代码新建Excel文件，需新引用Microsoft Excel 14.0 Object Library

10.png

其余代码其实和Excel-VBA中创建新的Excel文件一样，只是在最开始加上一个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:=excelAddress, FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False

Ps：本来打算使用left join，之前也有用过，今晚总是报错，好吧，换个方法

祝大家：国庆快乐！

• 本文为原创作品，如需转载，可加小编微信号learningBin

---

更多精彩，请关注微信公众号
扫描二维码，关注本公众号

公众号底部二维码.jpg