按固定模板格式批量打印

边缘码农 · 发表于 2024-7-12 10:46

fanion 发表于 2024-7-12 10:35
感谢你给的代码，测试没有通过，提示为”用户定义类型未定义“，不知要怎样修改，希望能给出修改的方法 ...

这个代码是百度AI给出的，是需要根据实际情况修改的。需要引用Adobe Acrobat的API。

边缘码农 · 发表于 2024-7-12 10:48

fanion 发表于 2024-7-12 10:38
期待老师您能将您所写的代码上传分享，同意的话我将一并写入文档中上传给大家一起分享，谢谢.....

Sub PrintRkd()
'-----------------------------------------------
' 填充并打印入库单
'
' 边缘码农 at 2027-7-12
'-----------------------------------------------
Dim RkdArr() ' 单张入库单数据数组
Dim RkdTotalArr() ' 按照入库单号码汇总的每张入库单的数据：入库单号码、明细数量、打印张数
Dim Ksh As Long, Jsh As Long '开始单号和结束单号
Dim Num As Long ' 单张入库单明细行数
Dim i As Long, j As Long, X As Long '循环变量
Dim RkdTotal As Long '1页纸打印入库单3张，计数变量
Dim RowJg As Long '两张入库单之间的间隔行数
Dim RkdNUM As Long '入库单数量控制
Dim T As Long '运行时间
Dim Arr As Variant '“数据库”工作表数据数组
'-----------------------------------------------
' 设置或取得基础数据
Application.ScreenUpdating = False
T = Timer
RowJg = 13
Arr = Sheets("数据库").UsedRange ' 读入数据库的内容到数组
With Sheets("模板")
Ksh = .Range("k5").Value ' 读入开始单号
Jsh = .Range("k6").Value ' 读入结束单号
End With
'-----------------------------------------------
' 取得ksh和jsh之间的入库单号码在数据库中存在的数量
For i = Ksh To Jsh
For j = 1 To UBound(Arr)
If CStr(Arr(j, 1)) = CStr(i) Then
RkdNUM = RkdNUM + 1
Exit For
End If
Next
Next
ReDim RkdTotalArr(1 To RkdNUM, 1 To 3)
'-----------------------------------------------
' 填充文本型入库单号码（当该号码在“数据库”工作表中存在时）
RkdNUM = 1
For i = Ksh To Jsh
For j = 1 To UBound(Arr)
If CStr(Arr(j, 1)) = CStr(i) Then
RkdTotalArr(RkdNUM, 1) = CStr(i)
RkdNUM = RkdNUM + 1
Exit For
End If
Next
Next
'-----------------------------------------------
' 取得各入库单的明细数量
For i = 2 To UBound(Arr)
For j = 1 To UBound(RkdTotalArr)
If CStr(Arr(i, 1)) = RkdTotalArr(j, 1) Then
RkdTotalArr(j, 2) = RkdTotalArr(j, 2) + 1
Exit For
End If
Next
Next
'-----------------------------------------------
' 取得各入库单的填充纸质入库单的张数
For j = 1 To UBound(RkdTotalArr)
If Int(RkdTotalArr(j, 2) / 6) = RkdTotalArr(j, 2) / 6 Then
RkdTotalArr(j, 3) = RkdTotalArr(j, 2) / 6
Else
RkdTotalArr(j, 3) = Int(RkdTotalArr(j, 2) / 6) + 1
End If
Next
'-----------------------------------------------
' 开始
'------------
RkdTotal = 0
For i = 1 To UBound(RkdTotalArr)
' 重定义单张入库单数组
ReDim RkdArr(1 To RkdTotalArr(i, 2), 1 To UBound(Arr, 2))
'----------------------------------
' 取得单张入库单的内容
Num = 0
For j = 2 To UBound(Arr)
If Arr(j, 1) = CStr(RkdTotalArr(i, 1)) Then
Num = Num + 1
For X = 1 To UBound(Arr, 2)
RkdArr(Num, X) = Arr(j, X)
Next
End If
Next
'----------------------------------
' 按照RkdTotalArr(I,3)的数量循环，这个数量是该张入库单要打印的张数
For j = 1 To RkdTotalArr(i, 3)
'----------------------------------
With Sheets("模板")
'写入总括数据
.Cells(4 + RkdTotal * RowJg, "B") = RkdArr(1, 3) '购货单位
.Cells(4 + RkdTotal * RowJg, "E") = RkdArr(1, 2) '入库日期
.Cells(4 + RkdTotal * RowJg, "I") = RkdArr(1, 1) '单据号
.Cells(13 + RkdTotal * RowJg, "H") = RkdArr(1, 13) '制单人
End With
'----------------------------------
For X = 1 To 6 ' 6是每份入库单可以打印的行数
With Sheets("模板")
' 写入明细数据
.Cells(6 + X - 1 + RkdTotal * RowJg, "A") = RkdArr((j - 1) * 6 + X, 4) '料号
.Cells(6 + X - 1 + RkdTotal * RowJg, "b") = RkdArr((j - 1) * 6 + X, 5) '货物名称
.Cells(6 + X - 1 + RkdTotal * RowJg, "c") = RkdArr((j - 1) * 6 + X, 6) '规格型号
.Cells(6 + X - 1 + RkdTotal * RowJg, "d") = RkdArr((j - 1) * 6 + X, 7) '车牌号
.Cells(6 + X - 1 + RkdTotal * RowJg, "e") = RkdArr((j - 1) * 6 + X, 8) '单位
.Cells(6 + X - 1 + RkdTotal * RowJg, "f") = RkdArr((j - 1) * 6 + X, 9) '数量
.Cells(6 + X - 1 + RkdTotal * RowJg, "g") = RkdArr((j - 1) * 6 + X, 10) '单价
.Cells(6 + X - 1 + RkdTotal * RowJg, "h") = RkdArr((j - 1) * 6 + X, 11) '金额
.Cells(6 + X - 1 + RkdTotal * RowJg, "i") = RkdArr((j - 1) * 6 + X, 12) '备注
End With
If (j - 1) * 6 + X = UBound(RkdArr) Then
Exit For
End If
Next X
'----------------------------------
' 判断是否需要打印
If RkdTotal = 2 Or (i = UBound(RkdTotalArr) And j = RkdTotalArr(i, 3)) Then
' 当：三张入库单均使用后，或数据已经处理完毕时，打印
Stop '这里可以写打印代码
'-----------------
' 清空“模板”工作表中3张入库单的具体内容
' 也可以将需要清空的单元格定义成一个单元格区域
With Sheets("模板")
.Range("B4:C4,E4:F4,I4,A6:I11,H13").ClearContents
.Range("B17:C17,E17:F17,I17,A19:I24,H26").ClearContents
.Range("B30:C30,E30:F30,I30,A32:I37,H39").ClearContents
End With
'-----------------
RkdTotal = 0
Else
RkdTotal = RkdTotal + 1
End If
DoEvents
'----------------------------------
Next j
Next i
MsgBox "打印结束！耗时" & Format(Timer - T, "0.00") & "秒"
Application.ScreenUpdating = True
End Sub

复制代码

fanion · 发表于 2024-7-12 14:38

再次感谢解答本贴的两位老师：” Wang-Way “ 和 ” 边缘码农 “，他们分享的代码都能够满足使用要求，现将老师的代码与测试文档一并上传分享，希望后续他人移植能用得上；另外，如有其他老师能分享解决批量打印到一个PDF文档上的问题，请续补上来，谢谢！（另：当前文档中解决打印到一个PDF文档采用的办法是：打印输出到虚拟打印机上再另行处理）

边缘码农 · 发表于 2024-7-12 14:58

fanion 发表于 2024-7-12 14:38
再次感谢解答本贴的两位老师：” Wang-Way “ 和 ” 边缘码农 “，他们分享的代码都能够满足使用要求，现 ...

打印到一个文档的方法，用导出：
ExportAsFixedFormat方法

边缘码农 · 发表于 2024-7-12 14:59

ysjjess · 发表于 2024-8-10 12:54

wang-way 发表于 2024-7-11 14:21

老师你好！想请教一下怎么连续打印，比如一张A4纸上，每天只打印指定的，就像银行存折那样，每次打印未打印的数据，之前的就不再重复打印，谢谢！（比如之前已经打印到第5行，今天有第6-8行，在前面打印了5行的纸上只打6-8行，之前的1-5行就不再重复打印）

blackttea1 · 发表于 2024-8-13 21:53

学习啦，谢谢

		自动登录	找回密码
密码			免费注册

[求助] 按固定模板格式批量打印

评分