导出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