ACCESS 用EXCEL打印报表

ACCESS报表真是一言难尽啊.看预览还挺正经的.

 结果,放大之后 ,它裂开了,我也裂开了....打印出来,谁看谁尴尬...

 调整了很久,还是解决不了,于是愤而改EXCEL.效果如下:

 

Private Sub Command647_Click()  '打印.点击后禁用此按钮,待操作完成后再恢复,如果你的代码可能出问题,可以加入容错语句
        Command647.Enabled = False
        CopySelectedRecordsToExcel
        Command647.Enabled = True
End Sub

Function GetNames() As String
    Dim rs As Recordset, n As Integer, names As String
    Set rs = CurrentDb.OpenRecordset("select distinct 申购人 from 刀具申购明细 where 选择=-1 ")
    n = rs.RecordCount
    rs.MoveFirst
    For i = 0 To n - 1
        names = names & "," & rs.Fields(0).Value
        rs.MoveNext
    Next
    rs.Close
    Set rs = Nothing
    GetNames = Mid(names, 2, 100)
End Function

Sub CopySelectedRecordsToExcel()Dim rs As Recordset
    Dim strSQL As String
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelWorksheet As Object
    Dim headerRange As Object
    
    Set excelApp = CreateObject("Excel.Application")
    Set excelWorkbook = excelApp.Workbooks.Add
    Set excelWorksheet = excelWorkbook.Sheets.Add
    Set rs = CurrentDb.OpenRecordset("FQ刀具申购清单")
    Set headerRange = excelWorksheet.Range("A1").Resize(1, rs.Fields.Count)
    fieldIndex = 1
    For Each fld In rs.Fields   '填充表头
        headerRange.cells(5, fieldIndex).Value = fld.Name
        fieldIndex = fieldIndex + 1
    Next fld
    With excelWorksheet
        .Range("A6").CopyFromRecordset rs   '填充数据
        '设置格式
        .Range("A1") = "东莞市华鑫精密有限公司"
        .Range("A1").Font.Size = 24
        .Range("A2") = "采 购 申 请 单"
        .Range("A2").Font.Size = 20
        .Range("A2").Font.Underline = True    '领料单加下划线
        .Range("A1:J2").HorizontalAlignment = 7   '跨列居中
        .Range("A5:J5").HorizontalAlignment = -4108   '标题居中
        .Range("A5").CurrentRegion.Borders.LineStyle = True   '主体加边框
        .Range("A4").Value = "申购人: " & GetNames
        .Range("h3").Value = "申购日期: " & DLookup("max(申购日期)", "刀具申购明细", "选择=-1")
        .Range("H4").Value = "申购单号: " & DLookup("申购单号", "刀具申购明细", "选择=-1")

        If Len(DHS) > 60 Then .Range("H2").Font.Size = 8
         .cells.Font.Name = "微软雅黑"       '设置字体
        
         
        '设置列宽
        .Columns("A:A").ColumnWidth = 8.8
        .Columns("B:B").ColumnWidth = 33.25
        .Columns("C:E").ColumnWidth = 5
        .Columns("F:F").ColumnWidth = 8.63
        .Columns("G:G").ColumnWidth = 11.88
        .Columns("H:H").ColumnWidth = 13
        .Columns("I:I").ColumnWidth = 10
        .Columns("H:I").ShrinkToFit = True  '自动缩小
        .Range("H3:H4").ShrinkToFit = False
        .Columns("J:J").ColumnWidth = 5
        .Columns("J:J").HorizontalAlignment = -4108        '设置行高.这里的赋值的EXCEL VBA不一样,我也是查了官方文档才知道的.
        .cells.RowHeight = 25
        .Rows("1:2").RowHeight = 28.5
        '打印设置.其实队了记录以外的数据,都应该放在页眉和页脚才对.我也是做完之后才想通的.需要注意的是,有很多属性的赋值是和EXCEL VBA是不一样的.
        With .PageSetup
            .PaperSize = 144    '设置A5R纸张.如果你不知道纸张的ID,可以用EXCEL的宏录制功能,然后看源代码
            ' 边距设置为 0
            .LeftMargin = excelApp.InchesToPoints(0)
            .RightMargin = excelApp.InchesToPoints(0)
            .HeaderMargin = excelApp.InchesToPoints(1.1)
            .centerHeader = "&""-,加粗""&10第 &P 页，共 &N 页, " & DCount("*", "刀具申购明细", "选择=-1") & "  行"
            .TopMargin = excelApp.InchesToPoints(0)
            .BottomMargin = excelApp.InchesToPoints(0.71)
            .PrintTitleRows = "$1:$5"   ' 顶端标题行设置.
            .FooterMargin = excelApp.InchesToPoints(0.17)
            .LeftFooter = "&""-,加粗""&10仓库签名: " & Chr(13) & Chr(13) & Chr(13) & "副总签名:"
            .CenterFooter = "&""-,加粗""&10科长签名:" & Chr(13) & Chr(13) & Chr(13) & Chr(13)
            .RightFooter = "&""-,加粗""&10经理签名:                           " & Chr(127) & Chr(13) & Chr(13) & Chr(13) & "总经理签名:                           " & Chr(127)
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
    End With
    excelApp.Visible = True
'    excelApp.Dialogs(xlDialogPrint).Show    '弹出系统打印对话框,这里我测试有问题
'    excelWorksheet.PrintOut '打印
'    excelWorkbook.Close False
'    excelApp.Quit
    ' 释放对象
    rs.Close
    Set rs = Nothing
'    Set excelApp = Nothing
End Sub

chr(127)是用来占坑的,不然它左边的空格会被页脚吃掉.

这里顺便说一下,指定一页打印多少行的问题.只要设置行高就可以了

.cells.RowHeight = 25
.Rows("1:2").RowHeight = 28.5