Access-培訓管理系統-15-輸出所有老師上課記錄
阿新 • • 發佈:2018-11-09
系統: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
更多精彩,請關注微信公眾號
掃描二維碼,關注本公眾號