Access-培訓管理系統-13-輸出個人培訓檔案
阿新 • • 發佈: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-09-29.xlsx
,其中日期為生成檔案當天的日期 - Excel中只含有一個工作表,名稱為:
個人培訓檔案
- 工作表中有四列:培訓課程名稱,培訓開始時間,培訓多少小時,培訓老師
- 每份檔案生成一個Excel檔案,命名方式:
輸出檔案
輸出Excel裡的內容
操作介面
**對應資料庫內的內容
03_培訓記錄
02_培訓課程
Part 2:邏輯過程
- 檢查學員姓名有無錄入
- 輸出該學員對應學員檔案
- 從03_培訓記錄記錄表中獲取該學員對應的培訓課程ID
- 以上一步驟獲取的培訓課程ID去02_培訓課程中查詢對應資訊
- 輸出資訊至Excel表格
Part 3:程式碼
- 在窗體中增加一個事件
- 呼叫模組內的過程
窗體內程式碼
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
程式碼截圖
模組內程式碼
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
程式碼截圖
Part 4:程式碼解讀
- 本篇程式碼較長,重點介紹如何在Access中通過程式碼新建Excel檔案,需新引用
Microsoft Excel 14.0 Object Library
其餘程式碼其實和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
更多精彩,請關注微信公眾號
掃描二維碼,關注本公眾號