1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
|
Public Function WriteToWORD()
'-------------------------------------------------------------------------------------------------------------------------------
Dim str_sector_array(0 To 1, 0 To 19) As String
str_sector_array(0, 0) = "c:\2012_NSCIA_documents\NSCIA_manual_11.doc"
str_sector_array(0, 1) = "c:\2012_NSCIA_documents\NSCIA_manual_21.doc"
str_sector_array(0, 2) = "c:\2012_NSCIA_documents\NSCIA_manual_23.doc"
str_sector_array(0, 3) = "c:\2012_NSCIA_documents\NSCIA_manual_31-33.doc"
str_sector_array(0, 4) = "c:\2012_NSCIA_documents\NSCIA_manual_42.doc"
str_sector_array(0, 5) = "c:\2012_NSCIA_documents\NSCIA_manual_44-45.doc"
str_sector_array(0, 6) = "c:\2012_NSCIA_documents\NSCIA_manual_48-49.doc"
str_sector_array(0, 7) = "c:\2012_NSCIA_documents\NSCIA_manual_51.doc"
str_sector_array(0, 8) = "c:\2012_NSCIA_documents\NSCIA_manual_52.doc"
str_sector_array(0, 9) = "c:\2012_NSCIA_documents\NSCIA_manual_53.doc"
str_sector_array(0, 10) = "c:\2012_NSCIA_documents\NSCIA_manual_54.doc"
str_sector_array(0, 11) = "c:\2012_NSCIA_documents\NSCIA_manual_55.doc"
str_sector_array(0, 12) = "c:\2012_NSCIA_documents\NSCIA_manual_56.doc"
str_sector_array(0, 13) = "c:\2012_NSCIA_documents\NSCIA_manual_61.doc"
str_sector_array(0, 14) = "c:\2012_NSCIA_documents\NSCIA_manual_62.doc"
str_sector_array(0, 15) = "c:\2012_NSCIA_documents\NSCIA_manual_71.doc"
str_sector_array(0, 16) = "c:\2012_NSCIA_documents\NSCIA_manual_72.doc"
str_sector_array(0, 17) = "c:\2012_NSCIA_documents\NSCIA_manual_81.doc"
str_sector_array(0, 18) = "c:\2012_NSCIA_documents\NSCIA_manual_92.doc"
str_sector_array(0, 19) = "c:\2012_NSCIA_documents\NSCIA_manual_22.doc"
str_sector_array(1, 0) = "tbl_2007_union_last_11"
str_sector_array(1, 1) = "tbl_2007_union_last_21"
str_sector_array(1, 2) = "tbl_2007_union_last_23"
str_sector_array(1, 3) = "tbl_2007_union_last_31-33"
str_sector_array(1, 4) = "tbl_2007_union_last_42"
str_sector_array(1, 5) = "tbl_2007_union_last_44-45"
str_sector_array(1, 6) = "tbl_2007_union_last_48-49"
str_sector_array(1, 7) = "tbl_2007_union_last_51"
str_sector_array(1, 8) = "tbl_2007_union_last_52"
str_sector_array(1, 9) = "tbl_2007_union_last_53"
str_sector_array(1, 10) = "tbl_2007_union_last_54"
str_sector_array(1, 11) = "tbl_2007_union_last_55"
str_sector_array(1, 12) = "tbl_2007_union_last_56"
str_sector_array(1, 13) = "tbl_2007_union_last_61"
str_sector_array(1, 14) = "tbl_2007_union_last_62"
str_sector_array(1, 15) = "tbl_2007_union_last_71"
str_sector_array(1, 16) = "tbl_2007_union_last_72"
str_sector_array(1, 17) = "tbl_2007_union_last_81"
str_sector_array(1, 18) = "tbl_2007_union_last_92"
str_sector_array(1, 19) = "tbl_2007_union_last_22"
MsgBox ("Close all open MS WORD documents before continuing.")
MsgBox ("It takes about 10 minutes to generate the NSCIA manual in MS Word.")
Dim i As Integer
i = 0
For i = 0 To 2
Dim rs_source_qry As ADODB.Recordset
Dim wrdApp As Word.Application
Dim doc As Word.Document '"doc" = "wrdApp.ActiveDocument" ??
'Dim strCopyFile As String
Dim str_sql As String
Dim msg As String
Dim msg2 As String
Dim str_NSCIA_Code_out As String
'Dim int_pad As Integer
Dim rng As Range
'Dim strFileSpec As String
Dim str_description As String
str_description = ""
Dim ilex_flag As String
ilex_flag = "no"
Dim xref_flag As String
xref_flag = "no"
Dim tab_ctr As Integer
tab_ctr = 1
Dim n As Integer
n = 0
Dim z As Integer
z = 0
Dim y As Integer
y = 0
Dim previous_NSCIA As String
previous_NSCIA = ""
str_sql = "SELECT * FROM " & str_sector_array(1, i) & " order by myautonumber"
Set rs_source_qry = New ADODB.Recordset
rs_source_qry.Open str_sql, CurrentProject.Connection
'wrdApp.Quit ' Stops all open WORD instances
'Set wrdApp = Nothing ' Closes all open WORD instances
On Error Resume Next
For y = 0 To 19
Kill (str_sector_array(0, y)) ' Deletes pre-existing destination file.
Next y
Set wrdApp = CreateObject("word.Application")
On Error Resume Next
Set doc = wrdApp.Documents.Open(str_sector_array(0, i))
Set doc = wrdApp.Documents.Add("mytemplate.dot")
' See C:\Documents and Settings\carba001\Application Data\Microsoft\Templates\mytemplate.dot
' MsgBox ("Change File\Page Setup\Left (and Right) Margins to 2 inches")
' MsgBox ("Change File\Page Setup\Top Margin to 1.65 inches")
' MsgBox ("Change File\Page Setup\Bottom Margins to 2.25 inches")
If doc Is Nothing Then
Set doc = wrdApp.Documents.Add
' doc.SaveAs "c:\2012_NSCIA_documents\NSCIA_manual.doc"
End If
Set rng = doc.Range
doc.ActiveDocument.Select
'wrdApp.ActiveDocument.PageSetup.LeftMargin = 0
'With ActiveDocument.PageSetup
' .LeftMargin = 1
'End With
doc.DefaultTabStop = 3.8 ' This is in points
rng.PageSetup.LeftMargin = 2800 ' This is in twips or 1440 per inch
rng.PageSetup.RightMargin = 2800
rng.PageSetup.TopMargin = 2376
rng.PageSetup.BottomMargin = 3240
rng.Font.Name = "Times New Roman"
rng.Font.Bold = False
rng.Font.Size = 10
Do While Not rs_source_qry.EOF
rng.Collapse wdCollapseEnd
str_description = ""
'wrdApp.Selection.ParagraphFormat.FirstLineIndent = 0
If tab_ctr > 0 Then
wrdApp.Selection.ParagraphFormat.TabHangingIndent -(tab_ctr) ' This represents a number of TabStops
tab_ctr = 0
End If
'-------------------------------------------------------------------------------------------------------------->
' NEW GROUP
'-------------------------------------------------------------------------------------------------------------->
If rs_source_qry!NSCIA_Code <> previous_NSCIA Then
'If rs_source_qry!NSCIA_Code <> "11" And Len(rs_source_qry!NSCIA_Code) < 3 Then
' wrdApp.Selection.TypeText vbFormFeed
'End If
If xref_flag = "yes" Then
wrdApp.Selection.Paragraphs(1).LineSpacing = 6
wrdApp.Selection.TypeParagraph
wrdApp.Selection.Paragraphs(1).LineSpacing = 12
End If
xref_flag = "no"
wrdApp.Selection.ParagraphFormat.LeftIndent = normal
wrdApp.Selection.Paragraphs(1).SpaceAfter = normal
'---write title----------------------------------------------------------------------------------------->
wrdApp.Selection.ParagraphFormat.FirstLineIndent = 0 ' Measured in points
str_NSCIA_Code_out = rs_source_qry!NSCIA_Code & String(2 * (6 - Len(rs_source_qry!NSCIA_Code)), " ")
If Len(rs_source_qry!NSCIA_Code) < 3 Then
wrdApp.Selection.Font.Size = 14
wrdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End If
wrdApp.Selection.Font.Bold = True
wrdApp.Selection.TypeText str_NSCIA_Code_out
wrdApp.Selection.TypeText " "
wrdApp.Selection.TypeText rs_source_qry!Title
wrdApp.Selection.TypeText " "
wrdApp.Selection.Font.Superscript = True
wrdApp.Selection.TypeText Nz(rs_source_qry!Country)
wrdApp.Selection.Font.Bold = False
wrdApp.Selection.Font.Superscript = False
wrdApp.Selection.Font.Size = 10
'wrdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
'---write descripton------------------------------------------------------------------------------------>
If Left(rs_source_qry!Industry_Description, 3) <> "See" Then
If rs_source_qry!Industry_Description <> "" Then
str_description = rs_source_qry!Industry_Description
If InStr(str_description, vbCrLf & vbCrLf) > 0 Then 'Just one vbCrLf = chr(13) & chr(10)
End If
n = 0
If Len(str_description) > 3000 Then
z = 20
Else
If Len(str_description) > 900 Then
z = 8
Else
z = 4
End If
End If
Do While Not n > z
Mid(str_description, InStr(str_description, vbCrLf & vbCrLf), 2) = " "
n = n + 1
Loop
If Left(str_description, 21) = "The Sector as a Whole" Then
Mid(str_description, 22, 2) = vbCrLf
End If
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
wrdApp.Selection.ParagraphFormat.FirstLineIndent = 5 ' Measured in points
wrdApp.Selection.TypeText str_description
End If
Else 'book says "See Industry Description for _____ below"
If rs_source_qry!Industry_Description <> "" Then
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeText " "
wrdApp.Selection.TypeText rs_source_qry!Industry_Description
End If
End If
wrdApp.Selection.TypeParagraph
wrdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
wrdApp.Selection.TypeParagraph
previous_NSCIA = rs_source_qry!NSCIA_Code
wrdApp.Selection.ParagraphFormat.FirstLineIndent = 0
If rs_source_qry!left_col <> "" Then
wrdApp.Selection.Paragraphs(1).SpaceAfter = 6
wrdApp.Selection.Font.Italic = True
wrdApp.Selection.TypeText rs_source_qry!ilex_header
wrdApp.Selection.Font.Italic = False
'wrdApp.Selection.Paragraphs(1).SpaceAfter = normal
'wrdApp.Selection.TypeParagraph
If ilex_flag = "no" Then
ilex_flag = "yes"
Set rng = doc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak wdSectionBreakContinuous
rng.Collapse wdCollapseEnd
rng.PageSetup.TextColumns.SetCount 2
rng.Collapse wdCollapseEnd
rng.PageSetup.TextColumns.Width = 150 ' one inch = 72 points
rng.Select
wrdApp.Selection.ParagraphFormat.LeftIndent = 10
End If
wrdApp.Selection.ParagraphFormat.TabHangingIndent 2 ' This represents a number of TabStops
tab_ctr = tab_ctr + 2
wrdApp.Selection.Paragraphs(1).SpaceAfter = normal
wrdApp.Selection.TypeText rs_source_qry!left_col
'wrdApp.Selection.typetext " "
'wrdApp.Selection.typetext rs_source_qry!right_col
wrdApp.Selection.TypeParagraph
Else
If ilex_flag = "yes" Then
ilex_flag = "no"
Set rng = doc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak wdSectionBreakContinuous
rng.Collapse wdCollapseEnd
rng.PageSetup.TextColumns.SetCount 1
rng.Select
wrdApp.Selection.ParagraphFormat.LeftIndent = normal
'wrdApp.Selection.ParagraphFormat.FirstLineIndent = 0
End If
End If
'---write cross-reference-------------------------------------------------------------------------------------->
If rs_source_qry!Reconstituted_xref <> "" Then
xref_flag = "yes"
wrdApp.Selection.Paragraphs(1).SpaceAfter = 6
wrdApp.Selection.Font.Italic = True
wrdApp.Selection.TypeText rs_source_qry!xref_header
wrdApp.Selection.Font.Italic = False
wrdApp.Selection.TypeText rs_source_qry!xref_header2
'wrdApp.Selection.Font.Italic = False
wrdApp.Selection.TypeParagraph
If rs_source_qry!xref_bullet <> "" Then
wrdApp.Selection.ParagraphFormat.LeftIndent = 20
wrdApp.Selection.ParagraphFormat.TabHangingIndent 2 ' This represents a number of TabStops
tab_ctr = tab_ctr + 2
wrdApp.Selection.TypeText rs_source_qry!xref_bullet & rs_source_qry!Reconstituted_xref
Else
wrdApp.Selection.ParagraphFormat.FirstLineIndent = 5 ' Measured in points
wrdApp.Selection.TypeText rs_source_qry!xref_bullet & rs_source_qry!Reconstituted_xref
End If
'wrdApp.Selection.typeparagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
End If
'------------------------------------------------------------------------------------------------------------------>
' NOT NEW GROUP. See if record is an ilex or xref
'------------------------------------------------------------------------------------------------------------------>
Else
'msg = rs_source_qry!NSCIA_Code & " " & "previous_sortby = " & previous_sortby & " " & "rs_source_qry!SortBy = " & rs_source_qry!SortBy
'MsgBox msg
If rs_source_qry!left_col <> "" Then
If ilex_flag = "no" Then
ilex_flag = "yes"
Set rng = doc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak wdSectionBreakContinuous
rng.Collapse wdCollapseEnd
rng.PageSetup.TextColumns.SetCount 2
rng.Collapse wdCollapseEnd
rng.PageSetup.TextColumns.Width = 150 ' one inch = 72 points
rng.Select
wrdApp.Selection.ParagraphFormat.LeftIndent = 10
End If
wrdApp.Selection.ParagraphFormat.TabHangingIndent 2 ' This represents a number of TabStops
tab_ctr = tab_ctr + 2
wrdApp.Selection.TypeText rs_source_qry!left_col
'wrdApp.Selection.typetext " "
'wrdApp.Selection.typetext rs_source_qry!right_col
'wrdApp.Selection.typeparagraph
Else
If ilex_flag = "yes" Then
ilex_flag = "no"
Set rng = doc.Range
rng.Collapse wdCollapseEnd
rng.InsertBreak wdSectionBreakContinuous
rng.Collapse wdCollapseEnd
rng.PageSetup.TextColumns.SetCount 1
rng.Select
wrdApp.Selection.ParagraphFormat.LeftIndent = normal
wrdApp.Selection.ParagraphFormat.FirstLineIndent = 0
End If
End If
If rs_source_qry!Reconstituted_xref <> "" Then
If xref_flag = "no" Then
'xref_flag = "yes"
wrdApp.Selection.TypeParagraph
wrdApp.Selection.Paragraphs(1).SpaceAfter = 6
wrdApp.Selection.Font.Italic = True
wrdApp.Selection.TypeText rs_source_qry!xref_header
wrdApp.Selection.Font.Italic = False
wrdApp.Selection.TypeText rs_source_qry!xref_header2
'wrdApp.Selection.Font.Italic = False
wrdApp.Selection.TypeParagraph
'wrdApp.Selection.ParagraphFormat.LeftIndent = 20
End If
If rs_source_qry!xref_bullet <> "" Then
If xref_flag = "no" Then
wrdApp.Selection.ParagraphFormat.LeftIndent = 20
End If
wrdApp.Selection.ParagraphFormat.TabHangingIndent 2 ' This represents a number of TabStops
tab_ctr = tab_ctr + 2
wrdApp.Selection.TypeText rs_source_qry!xref_bullet & rs_source_qry!Reconstituted_xref
Else
wrdApp.Selection.ParagraphFormat.FirstLineIndent = 5 ' Measured in points
wrdApp.Selection.TypeText rs_source_qry!xref_bullet & rs_source_qry!Reconstituted_xref
End If
xref_flag = "yes"
End If
wrdApp.Selection.TypeParagraph
wrdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
End If
rs_source_qry.MoveNext
Loop
wrdApp.Visible = True
'wrdApp.ActiveDocument.SaveAs "c:\2012_NSCIA_documents\NSCIA_manual.doc"
doc.SaveAs str_sector_array(0, i)
rs_source_qry.Close
'wrdApp.Documents.Close "c:\2012_NSCIA_documents\NSCIA_manual.doc"
Set rs_source_qry = Nothing
'Set doc = Nothing
Set wrdApp = Nothing
Set doc = Nothing
'strFileSpec = ActiveDocument.FullName
'ActiveDocument.Close
'Kill strFileSpec
MsgBox ("i = " & i)
i = i + 1
Next i
End Function
|
