Here is the source code:
Private Sub WRDGovtAlt()
'jet and prop jet -- government
'Dim ado_RegNo As New ADODB.Recordset
Dim CntryName As String
Dim OldCntryName As String
Dim RegPrefix As String
Dim J As Integer
Dim ado_wrd As ADOD
Dim CntryName As String
Dim OldCntryName As String
Dim RegPrefix As String
Dim J As Integer
Dim ado_wrd As ADODB.Recordset
Dim RegNo As String
Dim PriorReg As String
Dim SerialNO As String
Dim CompName As String
Dim OldCompName As String
Dim ac_id As Long
Dim old_ac_id As Long
Dim MyRange As Range
Dim tmp As String
Dim MyCell As Cell
Dim MaxRecs As Long
Dim NumRecs As Long
Dim PDate As Variant
Dim MyRow As Object
Dim Kount As Integer
Dim oldKount As Integer
Dim Pass As Integer
Dim AltPrefix As String
Dim LinesPerPage As Integer
Dim LinesOnPage As Integer
Dim LinesRemaining As Integer
Dim SplitPage As Boolean
Dim RemainingRecs As Integer
Dim RecsRead As Integer
Dim LastRow As Integer
Dim Header(5) As String
Dim Header2 As String
Dim Num As Integer
'Dim PtsFromBottom As Long
' Dim PtsPerInch As Long
Dim LineAdjust As Integer
Dim BreakPage As Long
' LinesPerPage = 78 '65 ' 55 '65
' LinesOnPage = 0
'PtsPerInch = 72
' LineAdjust = 0
On Error GoTo WrdGovtAlt_Error
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
DoEvents
WordApp.Selection.Style = WordApp.ActiveDocument.Styles("Normal")
WordApp.Selection.Font.Name = "Arial"
WordApp.Selection.Font.Size = 6
WordApp.Selection.Font.Underline = True
OldCompName = ""
CompName = ""
OldCntryName = ""
Kount = 0
oldKount = WordApp.Selection.Information(wdActiveEndPageNumber)
Set MYtable = WordDoc.Tables.Add(WordApp.Selection.Range, 2, 5)
LastRow = 1
WordApp.Selection.Font.Underline = True
Header(1) = "REG #"
Header(2) = "MAKE/MODEL"
Header(3) = "SERIAL #"
Header(4) = "SERIAL #"
Header(5) = "PREV REG"
MYtable.Cell(LastRow, 1) = Header(1)
MYtable.Cell(LastRow, 2) = Header(2)
MYtable.Cell(LastRow, 3) = Header(3)
MYtable.Cell(LastRow, 4) = Header(4)
MYtable.Cell(LastRow, 5) = Header(5)
MYtable.Cell(LastRow, 1).Width = WordApp.InchesToPoints(0.6)
MYtable.Cell(LastRow, 2).Width = WordApp.InchesToPoints(0.9)
MYtable.Cell(LastRow, 3).Width = WordApp.InchesToPoints(0.6)
MYtable.Cell(LastRow, 4).Width = WordApp.InchesToPoints(1.4)
MYtable.Cell(LastRow, 5).Width = WordApp.InchesToPoints(0.5)
MYtable.Rows.AllowBreakAcrossPages = False
MYtable.AllowAutoFit = False
WordApp.Selection.Font.Underline = False
With WordApp.Selection.Tables(1)
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With WordApp.Options
.DefaultBorderLineStyle = wdLineStyleNone ' wdLineStyleSingle
' .DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
'set table header
MYtable.Rows(1).Select
WordApp.Selection.Style = WordApp.ActiveDocument.Styles("Normal")
WordApp.Selection.Font.Name = "Arial"
WordApp.Selection.Font.Size = 6
WordApp.Selection.Font.Underline = True
MYtable.Rows(1).HeadingFormat = True
MYtable.Rows(2).Select
WordApp.Selection.Style = WordApp.ActiveDocument.Styles("Normal")
WordApp.Selection.Font.Name = "Arial"
WordApp.Selection.Font.Size = 1
WordApp.Selection.Font.Underline = False
OldCntryName = "x"
OldCompName = "x"
CntryName = ""
CompName = ""
StartRow = 0
NumRecs = 0
Header2 = ""
If Testing Then
Query = "Select top 200 ac_reg_no, amod_make_name, amod_model_name,
ac_ser_no_full, comp_name, "
Else
Query = "Select ac_reg_no, amod_make_name, amod_model_name,
ac_ser_no_full, comp_name, "
End If
Query = Query & "ac_prev_reg_no, ac_id,
ac_purchase_date,ac_country_of_registration from View_JETPROP_AC_Gov "
Query = Query & "group by ac_reg_no, amod_make_name, amod_model_name,
ac_ser_no_full, comp_name, "
Query = Query & "ac_prev_reg_no, ac_id,
ac_purchase_date,ac_country_of_registration "
Query = Query & "order by
ac_country_of_registration,ac_reg_no,comp_name,ac_id "
Set ado_wrd = New ADODB.Recordset
ado_wrd.Open Query, Main_DB, adOpenStatic, adLockReadOnly, adCmdText
If Not (ado_wrd.EOF And ado_wrd.BOF) Then
ado_wrd.MoveLast
MaxRecs = ado_wrd.RecordCount
ado_wrd.MoveFirst
old_ac_id = 0
Do While Not ado_wrd.EOF
NumRecs = NumRecs + 1
SerialNO = Trim(ado_wrd!ac_ser_no_full & "")
RegNo = Trim(ado_wrd!ac_reg_no & "")
PriorReg = Trim(ado_wrd!ac_prev_reg_no & "")
Make = Trim(ado_wrd!amod_make_name & "")
Model = Trim(ado_wrd!amod_model_name & "")
CompName = Trim(ado_wrd!Comp_name & "")
ac_id = Val(ado_wrd!ac_id & "")
PDate = Trim(ado_wrd!ac_purchase_date & "")
CntryName = Trim(ado_wrd!ac_country_of_registration & "")
MakeModel = Make & " " & Model
If CntryName <> OldCntryName Then
Num = MYtable.Rows(LastRow).Cells.count
If Num = 1 Then
MYtable.Rows(LastRow).Select
MYtable.Range.Cells.Add
BeforeCell:=MYtable.Cell(LastRow, 1)
MYtable.Range.Cells.Add
BeforeCell:=MYtable.Cell(LastRow, 1)
MYtable.Range.Cells.Add
BeforeCell:=MYtable.Cell(LastRow, 1)
MYtable.Range.Cells.Add
BeforeCell:=MYtable.Cell(LastRow, 1)
Num = MYtable.Rows(LastRow).Cells.count
End If
Header2 = IIf(CntryName = "", "Unknown", CntryName)
lblAutoProgress.Caption = Header2
DoEvents
tmp = MYtable.Cell(LastRow, 1)
tmp = Replace(tmp, Chr(7), "")
tmp = Trim(Replace(tmp, Chr(13), ""))
If tmp <> "" Then
If Num > 1 Then
WordApp.Selection.InsertRowsBelow 1
End If
End If
LastRow = MYtable.Rows.count
MYtable.Rows(LastRow).Select
WordApp.Selection.Style =
WordApp.ActiveDocument.Styles("Heading 2")
MYtable.Cell(LastRow, 1) = IIf(CntryName = "", "Unknown",
CntryName)
BreakPage =
WordApp.Selection.Information(wdActiveEndPageNumber)
StartRow = LastRow
DoEvents
LineAdjust = LineAdjust + 3
OldCntryName = CntryName
DoEvents
End If
If ac_id <> old_ac_id Then
If Len(Trim(CompName)) > 0 Then
If CompName = "Awaiting Documentation" Then
If Len(Trim(PDate)) = 0 Then
CompName = "Awaiting Docs"
Else
CompName = "Purch " & Format(PDate, "mm/dd/yy")
& " Awaiting Docs"
End If
End If
' Num = MYtable.Rows(LastRow).Cells.count
LastRow = MYtable.Rows.count
tmp = MYtable.Cell(LastRow, 1)
tmp = Replace(tmp, Chr(7), "")
tmp = Trim(Replace(tmp, Chr(13), ""))
If tmp <> "" Then
MYtable.Rows(LastRow).Select
WordApp.Selection.InsertRowsBelow 1
End If
LastRow = MYtable.Rows.count
MYtable.Rows(LastRow).Select
WordApp.Selection.Style =
WordApp.ActiveDocument.Styles("Normal")
WordApp.Selection.Font.Name = "Arial"
WordApp.Selection.Font.Size = 5
WordApp.Selection.Font.Underline = False
WordApp.Selection.Font.Bold = False
MYtable.Cell(LastRow, 1) = RegNo
MYtable.Cell(LastRow, 2) = MakeModel
MYtable.Cell(LastRow, 3) = SerialNO
MYtable.Cell(LastRow, 4) = WRDCleanOwnerName(CompName)
MYtable.Cell(LastRow, 5) = PriorReg
If Len(MakeModel) > 16 Or
Len(WRDCleanOwnerName(CompName)) > 39 Then
LineAdjust = LineAdjust + 1
End If
MYtable.Cell(LastRow, 1).Width =
WordApp.InchesToPoints(0.6)
MYtable.Cell(LastRow, 2).Width =
WordApp.InchesToPoints(0.9)
MYtable.Cell(LastRow, 3).Width =
WordApp.InchesToPoints(0.6)
MYtable.Cell(LastRow, 4).Width =
WordApp.InchesToPoints(1.4)
MYtable.Cell(LastRow, 5).Width =
WordApp.InchesToPoints(0.5)
If StartRow > 0 Then
Set MyRow = MYtable.Rows(StartRow)
MyRow.Cells.Merge
StartRow = 0
DoEvents
End If
End If
OldCompName = CompName
Else 'same ac_id
If Len(Trim(OldCompName)) > 0 Then
CompName = OldCompName & " & " & CompName
End If
End If
old_ac_id = ac_id
OldCompName = CompName
LinesOnPage = MYtable.Rows.count Mod LinesPerPage
If StartRow > 0 Then
Set MyRow = MYtable.Rows(StartRow)
MyRow.Cells.Merge
StartRow = 0
End If
DoEvents
Kount = WordApp.Selection.Information(wdActiveEndPageNumber)
If Kount <> oldKount Then
oldKount = Kount
If CntryName = OldCntryName Then
If BreakPage <> Kount Then
WordApp.Selection.InsertRowsBelow 1
'LastRow = 2
LastRow = MYtable.Rows.count
MYtable.Cell(LastRow, 1) = Header2
MYtable.Rows(LastRow).Select
WordApp.Selection.Style =
WordApp.ActiveDocument.Styles("Normal")
WordApp.Selection.Font.Name = "Arial"
WordApp.Selection.Font.Size = 10
WordApp.Selection.Font.Bold = True
'LineAdjust = LineAdjust + 2
StartRow = LastRow
End If
End If
End If
WordApp.Selection.InsertRowsBelow 1
LastRow = MYtable.Rows.count
lblRecs.Caption = NumRecs & "/" & MaxRecs
DoEvents
DoEvents
If Stopped Then
Exit Do
End If
lblProg.Caption = "Page: " &
WordApp.ActiveDocument.BuiltinDocumentProperties(wdPropertyPages).Value
DoEvents
WordApp.ActiveDocument.UndoClear
WRDNumAC = WRDNumAC + 1
ado_wrd.MoveNext
Loop
ado_wrd.Close
End If
lblProg.Caption = "Page: " &
WordApp.ActiveDocument.BuiltinDocumentProperties(wdPropertyPages).Value
DoEvents
If StartRow > 1 Then 'get the last section
Set MyRow = MYtable.Rows(StartRow)
MyRow.Cells.Merge
End If
ListStep.AddItem "step 4: " & NumRecs & " records"
Exit Sub
WrdGovtAlt_Error:
ListStep.AddItem "wrdgovt alt Error: " & Err.Number & " " &
Err.Description & " " & Query
Stopped = True
Exit Sub
Resume Next
End Sub
Cindy M -WordMVP- said:
Hi Art,
I'm afraid that Selection.Information is the only way to get this.
Unfortunately, there's no event that's triggered when Word generates a new page,
or anything like that.
Since we don't have any idea how you're coding the generation of these table
rows, it's hard to tell whether the problem is because the information isn't
coming back synchronously, or if it's a problem with how you've coded.
Perhaps it would be best to insert these headers after you've finished
populating the table?
I am using VB6 to create a word XP document consisting of several tables.
Each table contains a distinct set of data. The document is organized by
section and may end up being 300+ pages. I create the tables on the fly, by
jumping to a bookmark in a template document.
I used MYtable.Rows(1).HeadingFormat = True
to put a constant header on each table.
However, some of the tables need a secondary header for country.
When the country changes, I bold the table row, and use a [header 2] so
that I get a table-of-contents entry.
The problem is this:
If the data for the country does not fit all on one page, I want to insert a
seconday header on the second line of the new page - bold, but without a toc
entry.
I have tried various versions like:
Selection.Information(wdActiveEndPageNumber) or
Selection.Information(wdNumberOfPagesInDocument)
However, the Information property does not reliability tell me when the
table goes to a new page. Often, it would tell me that the page has changed 2
to 5 table rows into the next page.
Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail
