word双面打印代码

hank2611

模仿excel文件的双面打印宏 做了一个 word双面的宏。

1. Sub 半自动双面打印()
   
2.     Dim myPages As Integer
   
3.     Dim myBottonNum As Integer
   
4.     Dim myPrompt1 As String
   
5.     Dim myPrompt2 As String
   
6.     Dim i As Integer, s As String
   
7.    
   
8.     myPrompt1 = "在打印时发生错误，请检查你的打印机设置"
   
9.         myPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
   
10.         ' 取得文档页数
    
11.          '===============奇数页打印===========
    
12.         s = ""
    
13.         i = 1
    
14.         Do While i <= myPages
    
15.             s = s & i & ","
    
16.             i = i + 2
    
17.         Loop
    
18.         ss = Left(s, Len(s) - 1)  ' 去掉最后一个逗号
    
19.          Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
    
20.                 wdPrintDocumentContent, Copies:=1, Pages:=ss, PageType:= _
    
21.                 wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
    
22.                 True, PrintToFile:=False, PrintZoomColumn:=2, PrintZoomRow:=1, _
    
23.                 PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
    
24.    
    
25.        '===============奇数页打印===========
    
26.       
    
27.        If myPages Mod 2 = 1 Then
    
28.              i = myPages - 1
    
29.              myPrompt2 = "请将出纸器中已打印好一面的纸取出(最后一页)并将其翻转后放回到送纸器中，然后按下""确定""，继续打印"
    
30.    
    
31.           Else
    
32.              i = myPages
    
33.              myPrompt2 = "请将出纸器中已打印好一面的纸取出并将其翻转后放回到送纸器中，然后按下""确定""，继续打印"
    
34.    
    
35.           End If
    
36.       
    
37.        myBottonNum = MsgBox(myPrompt2, 1 + 48) '提示用户取出纸张，确认后继续打印
    
38.        If (myBottonNum = 1) Then
    
39.           '===============偶数页打印===========
    
40.          s = ""
    
41.         Do While i >= 2
    
42.             s = s & i & ","
    
43.             i = i - 2
    
44.         Loop
    
45.         ss = Left(s, Len(s) - 1)   ' 去掉最后一个逗号
    
46.          Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
    
47.                 wdPrintDocumentContent, Copies:=1, Pages:=ss, PageType:= _
    
48.                 wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
    
49.                 True, PrintToFile:=False, PrintZoomColumn:=2, PrintZoomRow:=1, _
    
50.                 PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
    
51.       
    
52.              '===============偶数页打印===========
    
53.     End If
    
54. 
    
55. 
    
56. End Sub
    

复制代码

hank2611

文件经测试不能正常打印。不知道什么原理，代码不结束，打印机就不开始工作。所以把上面的代码拆分为两个，先执行奇数，再执行偶数的。
也算方便。
有懂的可以解决一下吗。

1. Sub 半自动双面打印奇数页()
   
2.     Dim myPages As Integer
   
3.     Dim myBottonNum As Integer
   
4.     Dim myPrompt1 As String
   
5.     Dim myPrompt2 As String
   
6.     Dim i As Integer, s As String
   
7.    
   
8.     myPrompt1 = "在打印时发生错误，请检查你的打印机设置"
   
9.         myPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
   
10.         
    
11.         ' 取得文档页数
    
12.         
    
13.         
    
14.         If (myPages = 0) Then '如果为零，说明没有可打印内容，退出程序
    
15.             MsgBox "Microsoft Word 未发现任何可以打印的内容", 0 + 48
    
16.             Exit Sub
    
17.         End If
    
18.         
    
19.         If (myPages = 1) Then '判断是否只有一页，如果是，只打印第一页，然后退出
    
20.             Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
    
21.                 wdPrintDocumentContent, Copies:=1, Pages:="1", PageType:= _
    
22.                 wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
    
23.                 True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
    
24.                 PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
    
25.             If Err.Number = 1004 Then
    
26.                 MsgBox myPrompt1, 0 + 48 '提示用户发生打印错误
    
27.             End If
    
28.             Exit Sub
    
29.         End If
    
30.          '===============奇数页打印===========
    
31.         s = ""
    
32.         i = 1
    
33.         Do While i <= myPages
    
34.             s = s & i & ","
    
35.             i = i + 2
    
36.         Loop
    
37.         ss = Left(s, Len(s) - 1)  ' 去掉最后一个逗号
    
38.          Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
    
39.                 wdPrintDocumentContent, Copies:=1, Pages:=ss, PageType:= _
    
40.                 wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
    
41.                 True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
    
42.                 PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
    
43.    
    
44.        '===============奇数页打印===========
    
45.       
    
46.      
    
47. End Sub
    
48. 
    
49. 
    
50. Sub 半自动双面打印偶数页()
    
51.     Dim myPages As Integer
    
52.     Dim myBottonNum As Integer
    
53.     Dim myPrompt1 As String
    
54.     Dim myPrompt2 As String
    
55.     Dim i As Integer, s As String
    
56.    
    
57.     myPrompt1 = "在打印时发生错误，请检查你的打印机设置"
    
58.         myPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    
59.         
    
60.         ' 取得文档页数
    
61.         
    
62.         
    
63.         If (myPages = 0) Then '如果为零，说明没有可打印内容，退出程序
    
64.             MsgBox "Microsoft Word 未发现任何可以打印的内容", 0 + 48
    
65.             Exit Sub
    
66.         End If
    
67.         
    
68.         If (myPages = 1) Then '判断是否只有一页，如果是，只打印第一页，然后退出
    
69.             Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
    
70.                 wdPrintDocumentContent, Copies:=1, Pages:="1", PageType:= _
    
71.                 wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
    
72.                 True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
    
73.                 PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
    
74.             If Err.Number = 1004 Then
    
75.                 MsgBox myPrompt1, 0 + 48 '提示用户发生打印错误
    
76.             End If
    
77.             Exit Sub
    
78.         End If
    
79.          '===============奇数页打印===========
    
80.       
    
81.    
    
82.        '===============奇数页打印===========
    
83.       
    
84.        If myPages Mod 2 = 1 Then
    
85.              i = myPages - 1
    
86.              myPrompt2 = "请将出纸器中已打印好一面的纸取出(最后一页)并将其翻转后放回到送纸器中，然后按下""确定""，继续打印"
    
87.    
    
88.           Else
    
89.              i = myPages
    
90.              myPrompt2 = "请将出纸器中已打印好一面的纸取出并将其翻转后放回到送纸器中，然后按下""确定""，继续打印"
    
91.    
    
92.           End If
    
93.        DoEvents
    
94.        myBottonNum = MsgBox(myPrompt2, 1 + 48) '提示用户取出纸张，确认后继续打印
    
95.        If (myBottonNum = 1) Then
    
96.           '===============偶数页打印===========
    
97.          s = ""
    
98.         Do While i >= 2
    
99.             s = s & i & ","
    
100.             i = i - 2
     
101.         Loop
     
102.         ss = Left(s, Len(s) - 1)   ' 去掉最后一个逗号
     
103.          Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
     
104.                 wdPrintDocumentContent, Copies:=1, Pages:=ss, PageType:= _
     
105.                 wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
     
106.                 True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
     
107.                 PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
     
108.       
     
109.              '===============偶数页打印===========
     
110.     End If
     
111. End Sub

复制代码

weiyingde

我也遇到同样的问题。

hz007008

谢谢楼主分享

vistababy