按照模板把数据批量打印完

SCWYZJ

求助:上次的按照模板批量打印不够完美，就是符合条件的数据超过模板的最大数据条数，就不知怎么弄了，（见附件），我想的是不管数据多少，都要按照模板样式直至打印完符合条件的数据，不能破坏模板。麻烦老师再帮忙看看，如何写。小花静候！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.2

复制代码

quqiyuan

参与一下，供参考。。。
做了两个过程，一个打印输出，一个PDF输出，前面都一样，就是输出的时候改了下



PDF输出分页的

quqiyuan

代码如下。。。
Sub test()  '选择打印机，然后打印的方案
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet, arr(), brr
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("模板")
    Set sh = wb.Sheets("数据")
    brr = sh.Range("c5:l" & sh.Cells(Rows.Count, 3).End(3).Row)
    ReDim arr(1 To 10000, 1 To 8)
    For i = 1 To UBound(brr)
        If brr(i, 2) = sht.[b2] And brr(i, 1) = sht.[i2] Then
            n = n + 1
            For j = 4 To UBound(brr, 2)
                arr(n, j - 3) = brr(i, j)
            Next
            arr(n, 8) = brr(i, 3)
        End If
    Next
    Application.Dialogs(9).Show
    sht.PageSetup.PrintArea = "A1:I37"
    If n / 25 > 1 Then
        For i = 1 To Int(n / 25) + 1
            m = 0
            sht.[b4:i28].ClearContents
            If n > i * 25 Then x = i * 25 Else x = n
            For j = (i - 1) * 25 + 1 To x
                m = m + 1
                For k = 1 To 8
                    sht.Cells(m + 3, k + 1) = arr(j, k)
                Next
            Next
            sht.PrintOut
        Next
    Else
        sht.PrintOut
    End If
    Beep
End Sub


Sub test1()  '输出PDF的方案
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet, arr(), brr
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("模板")
    Set sh = wb.Sheets("数据")
    brr = sh.Range("c5:l" & sh.Cells(Rows.Count, 3).End(3).Row)
    ReDim arr(1 To 10000, 1 To 8)
    For i = 1 To UBound(brr)
        If brr(i, 2) = sht.[b2] And brr(i, 1) = sht.[i2] Then
            n = n + 1
            For j = 4 To UBound(brr, 2)
                arr(n, j - 3) = brr(i, j)
            Next
            arr(n, 8) = brr(i, 3)
        End If
    Next
    If n / 25 > 1 Then
        For i = 1 To Int(n / 25) + 1
            m = 0
            sht.[b4:i28].ClearContents
            If n > i * 25 Then x = i * 25 Else x = n
            For j = (i - 1) * 25 + 1 To x
                m = m + 1
                For k = 1 To 8
                    sht.Cells(m + 3, k + 1) = arr(j, k)
                Next
            Next
            sht.ExportAsFixedFormat xlTypePDF, wb.Path & "\输出页" & i & ".pdf"
        Next
    Else
        sht.ExportAsFixedFormat xlTypePDF, wb.Path & "\输出页" & i & ".pdf"
    End If
    Beep
End Sub

SCWYZJ

二位老师 的代码我都试了，2楼的打印出文件不见放在哪？4楼老师的代码不错，就是麻烦需要一小点改动（如图示）就更好了。谢谢

ykcbf1100

SCWYZJ 发表于 2024-7-25 08:39
二位老师 的代码我都试了，2楼的打印出文件不见放在哪？4楼老师的代码不错，就是麻烦需要一小点改动（如图 ...

生成的PDF文件就在当前目录下啊
重新上传一下吧。

quqiyuan

SCWYZJ 发表于 2024-7-25 08:39
二位老师 的代码我都试了，2楼的打印出文件不见放在哪？4楼老师的代码不错，就是麻烦需要一小点改动（如图 ...

修改了些，供参考。。。

ykcbf1100

改一下吧。

SCWYZJ

老师，我刚才忘了说，能否再麻烦再改下，把相同部门+日期的数据合同1个PDF文件多页的形式输出和直接打印。谢谢