|
|
本帖最后由 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
总结：本人经验浅，尽管可以正常运行，但总感觉以上的程序非常之复杂！希望有高人可以帮忙精简一下的同时保留所有功能吧。
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2014-8-24 18:02
楼主