我改进了EXCEL双面(奇偶页)打印程序，使它更加灵活了

anothers · 发表于 2014-8-24 18:02

本帖最后由 anothers 于 2014-8-24 18:16 编辑

很久以前就已经有高人编写了一段用于EXCEL双面打印的脚本了，但这个脚本欠缺灵活性！
当我使用这个程序时，那台老旧的打印机，打到其中一页把两张纸都吞进去了！ >_<!
这样子就导致了整个页面都错乱了，而且程序每执行一次都会把所有的页全部按奇偶排序打印一次！

这就促使我改进这个脚本了，改进后的这个程序会先要求用户输入起始页和结束页，然后再按奇偶排序打印。
功能如下：
①如果用户想打印全部，就直接按“确定”或者“回车”两次即可打印全部。
②程序对于输入的数据作了严格限制：只允许用户输入不少于零的、不大于工作表总页数的数字。否则将要求重新输入。
③用户按“取消”则退出脚本，防止死循环
④当起始页和结束页是相差1页的话：打印完一面后，程序会自动提示用户翻转同一张纸再次打印，当起始页和结束页一样时，则程序会知道用户只打印一面。
⑤起始页和结束页谁大谁小无关系，用户可以从第1页打印到第5页，也可以从第5页打印到第1页。
程序代码如下：

Sub 可选择页码范围的双面打印程序()
Dim pageTotal As Integer
Dim jPage As Integer
Dim dPage As Integer
Dim OK
pageTotal = Application.ExecuteExcel4Macro("get.document(50)")
Do '让用户输入起始页码，只允许用户输入不少于零的、不大于工作表总页数的数字，按取消则退出程序！
a = InputBox("请输入起始页码，直接按“确定”从第1页开始打印", "打印起始页", 1)
If StrPtr(a) = 0 Then
Exit Sub
ElseIf IsNumeric(a) = False Then
MsgBox "你输入的不是数字，请重新输入！"
ElseIf a * 1 > pageTotal Then
MsgBox "此工作表只有" & pageTotal & "页，请重新输入！"
ElseIf a * 1 < 0 Then
MsgBox "你不能输入少于零的页码，请重新输入！"
Else
Exit Do
End If
Loop
Do '让用户输入结束页码，只允许用户输入不少于零的、不大于工作表总页数的数字，按取消则退出程序！
b = InputBox("请输入结束页码，直接按“确定”为：第" & pageTotal & "页", "打印结束页", pageTotal)
If StrPtr(b) = 0 Then
Exit Sub
ElseIf IsNumeric(b) = False Then
MsgBox "你输入的不是数字，请重新输入！"
ElseIf b * 1 < 0 Then
MsgBox "你不能输入少于零的页码，请重新输入！"
ElseIf b * 1 > pageTotal Then
MsgBox "此工作表只有" & pageTotal & "页，请重新输入！"
Else
Exit Do
End If
Loop
Select Case b - a '根据用户输入的页码，分四种情况处理：
Case 0 '①起始页和结束页相同，即打印一页一面。
ActiveSheet.PrintOut from:=a, To:=a
Case 1, -1 '②起始页和结束页之差为1页，即打印一页两面。
ActiveSheet.PrintOut from:=a, To:=a
OK = MsgBox("请把这张纸反转另一面放到打印机，按“确定”再打印！", vbOKCancel, "双面打印")
ActiveSheet.PrintOut from:=b, To:=b
Case Is >= 2 '③起始页和结束页之差超过1页。
dPage = a
For jPage = b - IIf(b Mod 2 = 0, 1, 0) To a Step -2
ActiveSheet.PrintOut from:=jPage, To:=jPage
Next
OK = MsgBox("请把纸张装入打印机，打印偶数页", vbOKCancel, "双面打印")
If OK = vbOK Then
For dPage = a + IIf(a Mod 2 = 0, 0, 1) To b Step 2
ActiveSheet.PrintOut from:=dPage, To:=dPage
Next
End If
Case Is <= -2 '④起始页和结束页之差超过1页。这里灵活适应用户把起始页和结束页调转输入。
dPage = b
For jPage = a - IIf(a Mod 2 = 0, 1, 0) To b Step -2
ActiveSheet.PrintOut from:=jPage, To:=jPage
Next
OK = MsgBox("请把纸张装入打印机，打印偶数页", vbOKCancel, "双面打印")
If OK = vbOK Then
For dPage = b + IIf(b Mod 2 = 0, 0, 1) To a Step 2
ActiveSheet.PrintOut from:=dPage, To:=dPage
Next
End If
End Select
End Sub

复制代码

总结：本人经验浅，尽管可以正常运行，但总感觉以上的程序非常之复杂！希望有高人可以帮忙精简一下的同时保留所有功能吧。

ellasky · 发表于 2014-10-17 17:31

奇偶页打印，有时候是非常需需要的，谢谢分享

oceanwinder · 发表于 2014-10-27 11:04

试过了，灰常好用。。。谢谢

cskoias · 发表于 2014-10-27 22:46

这个一定要试试。

xw10xw · 发表于 2014-11-19 14:52

很有用的程序,学习了

EXCEL江湖 · 发表于 2014-12-13 08:07

收藏了！谢谢分享！

1249994139 · 发表于 2016-7-28 10:24

老师，请问下这句代码，咋不能得到工作表的总页数呢，总是等于1呀，
pageTotal = Application.ExecuteExcel4Macro("get.document(50)")
求大神解惑，谢谢！本人感觉很神，但就是用不了………………。

anothers · 发表于 2016-8-31 15:45

1249994139 发表于 2016-7-28 10:24
老师，请问下这句代码，咋不能得到工作表的总页数呢，总是等于1呀，
pageTotal = Application.ExecuteExce ...

把你的文档发上来看看才知道了正常来讲这个打印程序仅适合于同一个工作表需要多张纸打印出来用的

1249994139 · 发表于 2016-9-2 10:37

谢谢各位老师的帮助,已经解决了.谢谢!

shnvke · 发表于 2019-8-9 12:16

打印出的奇数页是倒数，能改成正的吗？谢谢了

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