打印代码出错。。

toddbckele

1. Option Explicit
   
2. 
   
3. Sub tt()
   
4. On Error Resume Next
   
5. 
   
6. Dim 最后行号, i, m, start1, end1 As Integer
   
7. Dim Word对象 As New Word.Application ', Fso As New FileSystemObject
   
8. Dim Str1, Str2, 当前路径, 导出路径, 导出文件名, 导出路径文件名, 邮编, 地址, 联系人, 联系人电话, 缴费号, 申请人 As String
   
9. 
   
10. 最后行号 = Sheets("Sheet1").Range("C65536").End(xlUp).Row
    
11. For i = 6 To 最后行号
    
12.     start1 = i                                  '根据不同缴费单号分类
    
13.     While Sheets("Sheet1").Cells(i, "AC") = Sheets("Sheet1").Cells(i + 1, "AC")
    
14.         i = i + 1
    
15.     Wend
    
16.     end1 = i
    
17.     With Sheets("Sheet1")
    
18.         Sheets("Sheet2").Rows("2:65536").Clear
    
19.         .Range(Cells(start1, "E"), Cells(end1, "G")).Copy Sheets("Sheet2").Range("B2")
    
20.         .Range(Cells(start1, "A"), Cells(end1, "A")).Copy
    
21.         Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues
    
22.         Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteFormats
    
23.         
    
24.         .Range(Cells(start1, "AO"), Cells(end1, "AO")).Copy                            '总计
    
25.         Sheets("Sheet2").Range("H2").PasteSpecial Paste:=xlPasteValues
    
26.         Sheets("Sheet2").Range("H2").PasteSpecial Paste:=xlPasteFormats
    
27.         
    
28.         .Range(Cells(start1, "I"), Cells(end1, "J")).Copy                            '官费和服务费
    
29.         Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues
    
30.         Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteFormats
    
31.         
    
32.         .Range(Cells(start1, "N"), Cells(end1, "N")).Copy                            '缴费期限
    
33.         Sheets("Sheet2").Range("G2").PasteSpecial Paste:=xlPasteValues
    
34.         Sheets("Sheet2").Range("G2").PasteSpecial Paste:=xlPasteFormats
    
35.          
    
36.         .Range(Cells(start1, "P"), Cells(end1, "P")).Copy                           '专利名称
    
37.         Sheets("Sheet2").Range("T2").PasteSpecial Paste:=xlPasteValues
    
38.         Sheets("Sheet2").Range("T2").PasteSpecial Paste:=xlPasteFormats
    
39.         
    
40.         .Range(Cells(start1, "AD"), Cells(end1, "AL")).Copy Sheets("Sheet2").Range("I2")
    
41.         .Range(Cells(start1, "AC"), Cells(end1, "AC")).Copy Sheets("Sheet2").Range("R2")
    
42.         
    
43.         .Cells(1, "Z") = Application.Sum(Sheets("Sheet2").Range("E2:E65536"))      '本期发生官费总金额
    
44.         .Cells(1, "X") = Application.Sum(Sheets("Sheet2").Range("F2:F65536"))      '本期发生服务费总金额
    
45.         .Cells(1, "V") = .Cells(1, "Z") + .Cells(1, "X")                          '本期应缴总额
    
46.         .Range(Cells(1, "U"), Cells(1, "V")).Copy Sheets("Sheet2").Cells(end1 - start1 + 3, "A")
    
47.     End With
    
48.     Sheets("Sheet2").UsedRange.Borders.ColorIndex = 0   '已使用的范围，即有内容的表格添加黑色边框线
    
49.         
    
50.     Sheets("Sheet2").UsedRange.Copy
    
51.     邮编 = Sheets("Sheet1").Cells(start1, "T")
    
52.     地址 = Sheets("Sheet1").Cells(start1, "U")
    
53.     联系人 = Sheets("Sheet1").Cells(start1, "V")
    
54.     联系人电话 = Sheets("Sheet1").Cells(start1, "W")
    
55.     申请人 = Sheets("Sheet1").Cells(start1, "C")
    
56.          
    
57.    当前路径 = "\\192.168.1.120\杭诚软件\缴费单"
    
58.    导出路径 = 当前路径 & "\已生成" & Format(Now, "yyyy-mm-dd")
    
59.    MkDir 导出路径
    
60.     导出文件名 = Cells(i, "AC") & ".doc"
    
61.    
    
62.    导出路径文件名 = 导出路径 & "" & 导出文件名
    
63.    'If Fso.FileExists(导出路径文件名) = True Then Fso.DeleteFile 导出路径文件名, True
    
64. 
    
65.    FileCopy 当前路径 & "\缴纳授权费用模板实样.doc", 导出路径文件名
    
66.    With Word对象
    
67.       .Documents.Open 导出路径文件名
    
68.       .Visible = True
    
69. 
    
70.       .Selection.HomeKey Unit:=wdStory
    
71.       .Selection.Find.Text = "[当前时间]"
    
72.       .Selection.Find.Execute
    
73.       .Selection = Format(Now, "yyyy-mm-dd")
    
74.            
    
75.       .Selection.HomeKey Unit:=wdStory
    
76.       .Selection.Find.Text = "[缴费号]"
    
77.       .Selection.Find.Execute
    
78.       .Selection = Sheet2.Cells(2, "R")
    
79.       
    
80.       .Selection.HomeKey Unit:=wdStory
    
81.       .Selection.Find.Text = "[收款账户]"
    
82.       .Selection.Find.Execute
    
83. '      .Selection = Cells(1, "J")
    
84.       .Selection = Sheet2.Cells(2, "J")
    
85.       
    
86.       .Selection.HomeKey Unit:=wdStory
    
87.       .Selection.Find.Text = "[银行账号]"
    
88.       .Selection.Find.Execute
    
89. '      .Selection = Cells(1, "L")
    
90.       .Selection = Sheet2.Cells(2, "K")
    
91.       
    
92.       .Selection.HomeKey Unit:=wdStory
    
93.       .Selection.Find.Text = "[开户银行]"
    
94.       .Selection.Find.Execute
    
95. '      .Selection = Cells(2, "K")
    
96.       .Selection = Sheet2.Cells(2, "L")
    
97.       
    
98.       .Selection.HomeKey Unit:=wdStory
    
99.       .Selection.Find.Text = "[公司地址]"
    
100.       .Selection.Find.Execute
     
101. '      .Selection = Cells(1, "P")
     
102.       .Selection = Sheet2.Cells(2, "M")
     
103.       
     
104.       
     
105.       .Selection.HomeKey Unit:=wdStory
     
106.       .Selection.Find.Text = "[公司邮编]"
     
107.       .Selection.Find.Execute
     
108. '      .Selection = Cells(2, "J")
     
109.       .Selection = Sheet2.Cells(2, "N")
     
110.       
     
111. '      .Selection.HomeKey Unit:=wdStory
     
112. '      .Selection.Find.Text = "[公司电话]"
     
113. '      .Selection.Find.Execute
     
114. ''      .Selection = Cells(2, "L")
     
115. '      .Selection = Sheet2.Cells(2, "O")
     
116. '
     
117. '      .Selection.HomeKey Unit:=wdStory
     
118. '      .Selection.Find.Text = "[公司传真]"
     
119. '      .Selection.Find.Execute
     
120. ''      .Selection = Cells(2, "N")
     
121. '      .Selection = Sheet2.Cells(2, "P")
     
122.       
     
123.       .Selection.HomeKey Unit:=wdStory
     
124.       .Selection.Find.Text = "[收款户名]"
     
125.       .Selection.Find.Execute
     
126. '      .Selection = Cells(2, "N")
     
127.       .Selection = Sheet2.Cells(2, "J")
     
128.       
     
129.       .Selection.HomeKey Unit:=wdStory
     
130.       .Selection.Find.Text = "[邮编]"
     
131.       .Selection.Find.Execute
     
132.       .Selection = 邮编
     
133. 
     
134.       .Selection.HomeKey Unit:=wdStory
     
135.       .Selection.Find.Text = "[地址]"
     
136.       .Selection.Find.Execute
     
137.       .Selection = 地址
     
138. 
     
139.       .Selection.HomeKey Unit:=wdStory
     
140.       .Selection.Find.Text = "[联系人]"
     
141.       .Selection.Find.Execute
     
142.       .Selection = 联系人
     
143. 
     
144.       .Selection.HomeKey Unit:=wdStory
     
145.       .Selection.Find.Text = "[联系人电话]"
     
146.       .Selection.Find.Execute
     
147.       .Selection = 联系人电话
     
148. 
     
149.       .Selection.HomeKey Unit:=wdStory
     
150.       .Selection.Find.Text = "[申请人]"
     
151.       .Selection.Find.Execute
     
152.       .Selection = 申请人
     
153.       
     
154.       .Selection.HomeKey Unit:=wdStory
     
155.       .Selection.Find.Text = "[缴费号]"
     
156.       .Selection.Find.Execute
     
157.       .Selection = 缴费号
     
158. 
     
159.       .Selection.HomeKey Unit:=wdStory
     
160.       .Selection.Find.Text = "[表格处]"
     
161.       .Selection.Find.Execute
     
162.       .Selection.PasteExcelTable False, False, False
     
163.       
     
164.      With .Selection.Find        '替换连续的手动换行符
     
165.         .Text = "^l^l"
     
166.         .Replacement.Text = "^p"
     
167.         .MatchWildcards = False
     
168.         .Execute Replace:=wdReplaceAll, Forward:=True, _
     
169.         Wrap:=wdFindContinue
     
170.      End With
     
171.      
     
172.     End With
     
173.    
     
174.    Word对象.Documents.Save
     
175. Word对象.ActiveDocument.PrintOut
     
176.    Word对象.Documents.Close
     
177. 
     
178. Next i
     
179.     Set Word对象 = Nothing
     
180.     Word对象.Quit
     
181. End Sub
     
182. 
     
183. 这段代码是调用系统模板打印的代码 ，问题就是不知道怎么原因，打到7-8分的时候就会出现莫名其妙的错误，格式变了，不知道是什么问题 还请指点一下~~！！
     
184. 
     
185. 
     
186. 
     
187. 
     
188. 
     

复制代码