实现按顺序连续打印

kuangben8

cbtaja 发表于 2016-5-11 17:00
不用改代码，安装一个著名的虚拟打印机FinePrint（有中文版v8.31的，单机版注册码HZUC-MGGY-5479），设为默 ...

感谢感谢！我来试试。

kuangben8

cbtaja 发表于 2016-5-11 17:00
不用改代码，安装一个著名的虚拟打印机FinePrint（有中文版v8.31的，单机版注册码HZUC-MGGY-5479），设为默 ...

需要安装一个PDF虚拟打印机，太棒了！终于解决了我的一个顽疾！

kuangben8

cbtaja 发表于 2014-8-23 10:08
这种情况，只需在执行打印命令的语句之前加上一句即可解决：
ＤｏＥｖｅｎｔｓ

老师，我想在单击按钮运行这段代码时先弹出对话框：询问是否确定打印，点击确定再运行打印程序，点击取消则结束打印程序。请教老师该怎么修改？谢谢！

cbtaja

在第3行代码之前插入一句：

1. If MsgBox("是否确定打印？", vbOKCancel) <> vbOK Then Exit Sub

复制代码

kuangben8

cbtaja 发表于 2016-6-17 03:47
在第3行代码之前插入一句：

感谢老师，谢谢！

yepulu

收藏学习了。

xyh2732

cbtaja 发表于 2014-8-23 10:08
这种情况，只需在执行打印命令的语句之前加上一句即可解决：
ＤｏＥｖｅｎｔｓ

现在可以连续打印。但是我需要用到虚拟打印的时候就会出现选择保存地址及文件名称的更改，如何可以使电脑根据我设定好的 打印机“O1”单元格，保存到指定地址“O2”单元格，以及自动更改图片文件名称 “Q1”单元格，我里有壹佰多条数据需要打印成图片一个一个选择台麻烦了 438515092_自动打印（选择分段打印）.rar (51.51 KB, 下载次数: 54)

2017-1-11 09:29 上传

点击文件名下载附件

cbtaja

xyh2732 发表于 2017-1-11 09:30
现在可以连续打印。但是我需要用到虚拟打印的时候就会出现选择保存地址及文件名称的更改，如何可以使电脑根 ...

你所说的O1、O2、Q1单元格，在附件表格中都 没有相应内容，我看大家都没有明白你的意思。把附件中的内容填写完整再说吧

xyh2732

cbtaja 发表于 2017-1-11 10:31
你所说的O1、O2、Q1单元格，在附件表格中都 没有相应内容，我看大家都没有明白你的意思。把附件中的内容 ...

谢谢你的回复，附件上传错了 单体砖图成型卡片.rar (189.15 KB, 下载次数: 37)

2017-1-11 10:52 上传

点击文件名下载附件

cbtaja

xyh2732 发表于 2017-1-11 10:51
谢谢你的回复，附件上传错了

再稍修改，添加对预定文件夹是否存在的判断、处理代码：If Dir([o2]) = "" Then MkDir [o2]

1. Sub 每一页各自打印成不同的PDF文件()
   
2. Dim fw$, fs&, endrow&, r&, phzx$, PrinterApplied As Boolean
   
3.    If MsgBox("是否确定打印？", vbOKCancel) <> vbOK Then Exit Sub
   
4.     If Dir([o2]) = "" Then MkDir [o2]
   
5.     fs = Sheet1.[m2]
   
6.     If fs < 1 Then Exit Sub
   
7.     endrow = Sheet2.[b65536].End(3).Row
   
8.     fw = Replace("q" & Sheet1.[m1], "-", ":q")
   
9.     For Each cel In Sheet2.Range(fw)
   
10.     r = cel.Row
    
11.     If r >= 5 And r <= endrow Then
    
12.         phzx = cel.Value
    
13.         Sheet1.[j1] = phzx
    
14.         DoEvents
    
15.         fileFullName = [o2] & IIf(Right([o2], 1) = "", "", "") & [q1] & ".pdf"
    
16.         fileFullName = Replace(fileFullName, "#", "-")
    
17.         
    
18.         If Application.Version >= "12" Then '适用于把多次打印内容打印到一个PDF文档内，条件是安装有EXCEL为2007或更高的版本。
    
19.         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    
20.             fileFullName, Quality:=xlQualityStandard, _
    
21.             IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    
22.             False
    
23.         Else
    
24.             MsgBox "必须安装EXCEL2007或更高版本！": Exit Sub
    
25.         End If
    
26.     End If
    
27. Next
    
28. MsgBox "完成！"
    
29. End Sub
    
30. 
    
31. 
    
32. Sub 所有页面合并打印一个PDF文档中()
    
33. Dim fw$, fs&, endrow&, r&, phzx$, PrinterApplied As Boolean
    
34.    If MsgBox("是否确定打印？", vbOKCancel) <> vbOK Then Exit Sub
    
35.     Application.Dialogs(xlDialogPrinterSetup).Show
    
36.     PrinterApplied = InStr(UCase(ActivePrinter), "PDF")
    
37.     If Dir([o2]) = "" Then MkDir [o2]
    
38.     fs = Sheet1.[m2]
    
39.     If fs < 1 Then Exit Sub
    
40.     endrow = Sheet2.[b65536].End(3).Row
    
41.     fw = Replace("q" & Sheet1.[m1], "-", ":q")
    
42.     For Each cel In Sheet2.Range(fw)
    
43.     r = cel.Row
    
44.     If r >= 5 And r <= endrow Then
    
45.         phzx = cel.Value
    
46.         Sheet1.[j1] = phzx
    
47.         DoEvents
    
48.         
    
49.         fileFullName = [o2] & IIf(Right([o2], 1) = "", "", "") & [q1]
    
50.         fileFullName = Replace(fileFullName, "#", "_")
    
51.         
    
52.        If PrinterApplied Then _
    
53.             Sheet1.PrintOut copies:=fs _
    
54.         Else _
    
55.             MsgBox "当前所选的打印机不是PDF虚拟打印机!": Exit Sub '适用于把多次打印内容打印到一个PDF文档内，必须安装有虚拟打印机。
    
56.     End If
    
57. Next
    
58. MsgBox "完成！"
    
59. End Sub
    

复制代码