如何自动打印标签

yueyiggjjddmm

根据打印数据表里的数据 计算出需要打印多少张、自动印出来
提前谢谢大神们


这是打印数据表

这是每个型号对应的，每箱数量

这是标签格式，一张纸可以打印四张标签

xiaoyaotan_lhb

最近我也做了一个类似的模板，挺好用的，可以交流一下

kuangben8

1. Sub 打印()
   
2.     Rem http://club.excelhome.net/thread-1512767-1-1.html
   
3.     Dim arr, brr
   
4.     Dim m%, n%, i%
   
5.     Dim dic As Object
   
6.     Set dic = CreateObject("Scripting.Dictionary")
   
7.     arr = Worksheets("每箱数量").Range("B2").CurrentRegion
   
8.     brr = Worksheets("打印数据表").Range("B2").CurrentRegion
   
9.     For m = 1 To UBound(arr, 1)
   
10.         dic(arr(m, 1)) = arr(m, 2)    '写入字典中方便后续查找
    
11.     Next
    
12.     With Worksheets("标签格式")
    
13.         For m = 2 To UBound(brr, 1)
    
14.             Union(.Cells(4, "C"), .Cells(25, "C"), .Cells(4, "K"), .Cells(25, "K")) = brr(m, 2)
    
15.             Union(.Cells(6, "C"), .Cells(27, "C"), .Cells(6, "K"), .Cells(27, "K")) = brr(m, 3)
    
16.             Union(.Cells(8, "C"), .Cells(29, "C"), .Cells(8, "K"), .Cells(29, "K")) = brr(m, 4)
    
17.             Union(.Cells(10, "C"), .Cells(31, "C"), .Cells(10, "K"), .Cells(31, "K")) = brr(m, 5)
    
18.             Union(.Cells(18, "C"), .Cells(39, "C"), .Cells(18, "K"), .Cells(39, "K")) = brr(m, 8)
    
19.             If brr(m, 6) > dic(brr(m, 2)) Then
    
20.                 n = brr(m, 6) \ dic(brr(m, 2))    '获取整数份数
    
21.                 i = brr(m, 6) Mod dic(brr(m, 2))  '多出来的非标准数量
    
22.                 If n \ 4 > 0 Then   '如果数量大于等于4份
    
23.                     Union(.Cells(14, "C"), .Cells(35, "C"), .Cells(14, "K"), .Cells(35, "K")) = dic(brr(m, 2)) & "(" & brr(m, 7) & ")"
    
24.                     .PrintOut Copies:=n \ 4 '先直接打印对应张纸
    
25.                 End If
    
26.                 If (n Mod 4 = 0) And (i > 0) Then
    
27.                     .Cells(14, "C") = i & "(" & brr(m, 7) & ")"
    
28.                     .Range("A1:D19").PrintOut Copies:=1, Collate:=True '然后按照选定区域打印一份
    
29.                 ElseIf n Mod 4 = 1 Then
    
30.                     .Cells(14, "C") = dic(brr(m, 2)) & "(" & brr(m, 7) & ")"
    
31.                     If i > 0 Then .Cells(14, "K") = i & "(" & brr(m, 7) & ")"
    
32.                     IIf(i > 0, .Range("A1:L19"), .Range("A1:D19")).PrintOut Copies:=1, Collate:=True '然后按照选定区域打印一份
    
33.                 ElseIf n Mod 4 = 2 Then
    
34.                     Union(.Cells(14, "C"), .Cells(14, "K")) = dic(brr(m, 2)) & "(" & brr(m, 7) & ")"
    
35.                     If i > 0 Then
    
36.                         .Cells(35, "C") = i & "(" & brr(m, 7) & ")"
    
37.                         .Cells(35, "K") = "多余的一份，请作废！"
    
38.                     End If
    
39.                     IIf(i > 0, .Range("A1:L40"), .Range("A1:L19")).PrintOut Copies:=1, Collate:=True '然后按照选定区域打印一份
    
40.                 ElseIf n Mod 4 = 3 Then
    
41.                     Union(.Cells(14, "C"), .Cells(14, "K"), .Cells(35, "C")) = dic(brr(m, 2)) & "(" & brr(m, 7) & ")"
    
42.                     .Cells(35, "K") = IIf(i > 0, i & "(" & brr(m, 7) & ")", "多余的一份，请作废！")
    
43.                     .PrintOut Copies:=1, Collate:=True   '然后按照选定区域打印一份
    
44.                 End If
    
45.             Else
    
46.                 Union(.Cells(14, "C"), .Cells(35, "C"), .Cells(14, "K"), .Cells(35, "K")) = brr(m, 6) & "(" & brr(m, 7) & ")"
    
47.                 .Range("A1:D19").PrintOut Copies:=1, Collate:=True   '按照选定区域打印一份
    
48.             End If
    
49.         Next
    
50.     End With
    
51.     MsgBox "打印已完成！"
    
52. End Sub

复制代码

kuangben8

参考附件，凑合着用。
标签打印.zip (30.87 KB, 下载次数: 21)

2019-12-14 19:56 上传

点击文件名下载附件

kuangben8

1. Sub 打印02()
   
2.     Dim arr, brr
   
3.     Dim m&, n&, i%, j&
   
4.     Dim dic As Object
   
5.     Set dic = CreateObject("Scripting.Dictionary")
   
6.     arr = Worksheets("每箱数量").Range("B2").CurrentRegion
   
7.     brr = Worksheets("打印数据表").Range("B2").CurrentRegion
   
8.     For m = 1 To UBound(arr, 1)
   
9.         dic(arr(m, 1)) = arr(m, 2)    '写入字典中方便后续查找
   
10.     Next
    
11.     i = 1    '给定初始循环值
    
12.     With Worksheets("标签格式")
    
13.         For m = 2 To UBound(brr, 1)
    
14.             Do
    
15.                 For n = i To 4
    
16.                     .Cells(4 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = brr(m, 2)
    
17.                     .Cells(6 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = brr(m, 3)
    
18.                     .Cells(8 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = brr(m, 4)
    
19.                     .Cells(10 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = brr(m, 5)
    
20.                     .Cells(18 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = brr(m, 8)
    
21.                     .Cells(14 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = dic(brr(m, 2)) & "(" & brr(m, 7) & ")"
    
22.                     j = j + dic(brr(m, 2))
    
23.                     If j > brr(m, 6) Then
    
24.                         .Cells(14 + Abs(n > 2) * 21, 3 + Abs(n Mod 2 = 0) * 8) = brr(m, 6) Mod dic(brr(m, 2)) & "(" & brr(m, 7) & ")"
    
25.                         If brr(m, 6) Mod dic(brr(m, 2)) <> 0 And n = 4 Then
    
26.                             n = 5   '如果最后一个数量大于0，刚好填完一行数据，此时m=4，但是要跳出循环并打印，所以令m=5
    
27.                         End If
    
28.                         Exit For   '结束内层循环
    
29.                     End If
    
30.                 Next
    
31.                 If n = 5 Or m = UBound(brr, 1) Then
    
32.                     .PrintOut Copies:=1   '满足四个标签填完就打印,或者最后一行数据
    
33.                     i = 1      '打印后重新填写，i值恢复到初始循环1
    
34.                 Else
    
35.                     If brr(m, 6) Mod dic(brr(m, 2)) = 0 Then
    
36.                         i = n     '下一次从n值开始循环填写
    
37.                     Else
    
38.                         i = n + 1  '在n基础上累加一次，进入下一个填写。
    
39.                     End If
    
40.                 End If
    
41.                 If j >= brr(m, 6) Then
    
42.                     j = 0
    
43.                     Exit Do   '结束Do循环
    
44.                 End If
    
45.             Loop
    
46.         Next
    
47.     End With
    
48.     MsgBox "打印已完成！"
    
49. End Sub

复制代码

kuangben8

给你修改一下打印方式，这样可以更加节省纸张一点。
标签打印.zip (32.25 KB, 下载次数: 37)

2019-12-14 23:10 上传

点击文件名下载附件