導出excel和PDF小結 vba

最近接觸了一個關於Access工具的項目，因此整理下須要使用的方法。

功能要求簡介：

　　1.將數據表中的數據導出到excel和PDF

　　2.並根據某個字段名稱分sheet輸出。

　　3.無模板方式

方案簡介：

　　1.設置頭部的標題內容和打印區域的單元格格式，標題內容的格式再單獨調整（比起一個個單元格調整，能夠提升效率）

　　2.copy設置好的單元格，一次性生成多個sheet.(開始建立sheet會有點時間開銷，但後面會快一點。整體上來講效率提升了)

　　3.而後就是每一個sheet的數據處理了

須要用到的函數：

　　不會寫的函數，可使用宏錄製，而後查看錄製的代碼

　　1.打印設置

　　　　

    With objCurSheet.PageSetup   'objCurSheet 當前sheet名稱
        .PaperSize = xlPaperA3      '打印紙大小：A3
        .Orientation = xlLandscape '打印方向：橫向
        .PrintTitleRows = "$1:$7"    '設置第一行至第七行爲標題
        .PrintTitleColumns = "A:O"  '設置A到O列爲標題列
        .PrintArea = "$A:$O"           '設置打印區域A到O列
        .BottomMargin = 26            '頁邊距
        .TopMargin = 26                 '頁邊距
    End With

　　2.設置單元格爲文本格式

　　　　

objCurSheet.Range("A:O").NumberFormatLocal = "@" '設置A到O列爲文本格式

　　3.設置單元格寬度

    objCurSheet.Columns("A").ColumnWidth = 9 

　　4.接下來就不繼續列舉單元格操做，你們本身錄製宏看吧。我說一下宏錄製的問題吧。

　　　　宏錄製時，Range等屬性前是不加表名的，而且會添加選中的操做，須要修改

　　　　好比：

    Range("B9").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

　　     其實上面的代碼應該改成以下（1.加上表對象，跟excel進程正常退出是有關係的。2.減小對象的選擇，能夠提升效率）：

　　　　

    With objCurSheet.Range("B9")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

 　　5.連接當前數據庫表，查詢方式以下：

　　　　

    Dim ExcelAp As New Excel.Application
    Dim ExcelBk As New Excel.workBook
    Set ExcelBk = ExcelAp.Workbooks.Add
    Dim ExcelSh As New Excel.Worksheet
    Dim Obj_DataBase As DAO.Database
    Dim Obj_Recordset As DAO.Recordset

    Set Obj_DataBase = CurrentDb()
    Application.SysCmd acSysCmdSetStatus, "Exporting" '設置Acess左下角的狀態提示
    
    Set Obj_Recordset = Obj_DataBase.OpenRecordset("tablename")

    Do While Not Obj_Recordset.EOF
    '數據處理

　　 Obj_Recordset.MoveNext
　　 Loop

　　6.導出excel和PDF,並打開excel

　　

If OutType = 1 Then
        extension = ".xls"
    Else
        extension = ".pdf"
    End If
    'Open the window to select the target folder
    Dim result As String
    '彈出選擇路徑的窗口 start
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Please select the target folder"
        .InitialFileName = "文件名" & extension
        If .Show = -1 Then
            result = .SelectedItems(1) ’獲取存儲路徑
        Else
            '退出進程並釋放資源
            ExcelBk.Close Savechanges:=False
            ExcelAp.Quit
            Set ExcelBk = Nothing
            Set ExcelAp = Nothing
            Set ExcelSh = Nothing
            Set Obj_DataBase = Nothing
            Set Obj_Recordset = Nothing
            Application.SysCmd acSysCmdSetStatus, "Exporting  canceled"
            Exit Function
        End If
    End With
    '彈出選擇路徑的窗口 end
    If OutType = 1 Then
        '保存文件
        ExcelBk.SaveAs FileName:=result
        ExcelBk.Close
        
        If InStr(1, result, ".xls") = 0 Then
            result = result & ".xls"
        End If
        
        '打開excel文件
        ExcelAp.Visible = True
        ExcelAp.Workbooks.Open FileName:=result
    Else
        '導出 PDF
        ExcelBk.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:=result, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=True, _
            OpenAfterPublish:=True
        ExcelBk.Close Savechanges:=False
        ExcelAp.Quit
    End If
    Set ExcelBk = Nothing
    Set ExcelAp = Nothing
    Set ExcelSh = Nothing
    Set Obj_DataBase = Nothing
    Set Obj_Recordset = Nothing