微信公眾號原文

系統：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中只含有一個工作表，名稱為：個人培訓檔案
   • 工作表中有四列：培訓課程名稱，培訓開始時間，培訓多少小時，培訓老師

輸出檔案

輸出Excel裡的內容

操作介面

**對應資料庫內的內容
03_培訓記錄

02_培訓課程

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
 

程式碼截圖

模組內程式碼

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：程式碼解讀

1. 本篇程式碼較長，重點介紹如何在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

更多精彩，請關注微信公眾號
掃描二維碼，關注本公眾號