EXCEL如何批量打印多个装箱单

445139855

想请教一个各位高人，能否帮写一个代码，箱单格式请见附件，需求是这样的：

1、装箱单的格式和内容都一样，就是在序号那里依次排列。因为每次都需要做很多个装箱单，工作量太大，想在EXCEL写一个代码，可以自由选择需要打印出多少印，然后系统自动就会生成相应数量的装箱单，序列自动排列。

2、在EXCEL中建立几个条目，“从第几页开始“、”打印多少页“，再生成一个按钮”按此键生成PDF文件“。

3、表格做好后，我不需要直接打印出来，而是要先生成一个PDF文件。比如说我选择打印100页，点击上面的按钮后，就自动生成一个含有100页排好序的箱单的PDF文件，然后我再把这个文件发给生产人员进行打印。

请各位大神帮帮忙，多谢了！

opiona

1. 
   
2. Sub Opiona()
   
3.    
   
4.     Rem 禁止系统刷屏?触发其他事件等
   
5.     'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
6.     Application.ScreenUpdating = False '//关闭屏幕刷新
   
7.     Application.DisplayAlerts = False '//关闭系统提示
   
8.     Application.EnableEvents = False  '//禁止触发其他事件
   
9.     Application.StatusBar = True   '关闭系统状态条
   
10.    
    
11.     Dim T
    
12.     T = Timer   '//开始时间
    
13.    
    
14.     Set SHX = Worksheets("AB")
    
15.     Set SHM = Worksheets("MAIN")
    
16.    
    
17.     SHX.Rows("23:65536").Delete Shift:=xlUp  '//只要第一页
    
18.     MINID = SHM.Range("B1").Value   '//起始ID
    
19.    
    
20.     Rem 计算要多少页，每页2张
    
21.     If SHM.Range("B2").Value Mod 2 = 0 Then
    
22.         Pages = Int(SHM.Range("B2").Value / 2)
    
23.     Else
    
24.         Pages = Int(SHM.Range("B2").Value / 2) + 1
    
25.     End If
    
26.    
    
27.     Rem 每一页
    
28.     For I = 1 To Pages
    
29.         
    
30.         Rem  提示信息，在状态栏显示
    
31.         Application.StatusBar = "总页数：" & Pages & " 当前是第：" & I & "  页"
    
32.         DoEvents
    
33.         
    
34.         IROW = (I - 1) * 22 + 1
    
35.         If I > 1 Then
    
36.             Rem 第2页起 复制第一页
    
37.             SHX.Rows("1:22").Copy SHX.Range("A" & IROW)
    
38.         End If
    
39.         
    
40.         Rem 添加页码
    
41.         SHX.Cells(IROW + 17 - 1, 1).Value = MINID + (I - 1) * 2
    
42.         SHX.Cells(IROW + 17 - 1, 9).Value = MINID + (I - 1) * 2 + 1
    
43.         
    
44.         Rem 插入图片 位置 大小，自己写吧
    
45.         
    
46.         
    
47.     Next
    
48.    
    
49.     Rem 另存为PDF代码 需要插件，自己写吧
    
50.    
    
51.     Application.StatusBar = False   '恢复系统状态条
    
52.     Application.EnableEvents = True  '//  '//恢复触发其他事件
    
53.     Application.ScreenUpdating = True '//恢复屏幕刷新
    
54.     Application.DisplayAlerts = True '//恢复系统提示
    
55.     MsgBox "一共用时：" & Format(Timer - T, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
56. End Sub

复制代码

opiona

QQ14885553.rar (22.16 KB, 下载次数: 79)

2018-9-12 17:02 上传

点击文件名下载附件

445139855

opiona 发表于 2018-9-12 17:02

您好，您发的附件我直接就可以使用吗？

opiona

445139855 发表于 2018-9-12 17:18
您好，您发的附件我直接就可以使用吗？

可以，甚至可以商业用途，哈哈