Hi all,

Can you tell me please what is the process to use this function.

1. how to call this function :- createApdxBDoc(outputArray() As CApdxB)

I have pasted this code into Vb project at run time it show user defined
error at "createApdxBDoc(outputArray() As CApdxB)" this point.

the code below attached.

Thanx
RAJ


Private Sub createApdxBDoc(outputArray() As CApdxB)
Dim objWord As Word.Application
Dim objDoc As Word.Document

Dim row As Integer
row = 5

'open word
Set objWord = New Word.Application
'add the document
Set objDoc = objWord.Documents.Add
'make it the current document
objDoc.Activate

'make it visible
objWord.Visible = True

'set page orientation to landscape (affects the table size)
objDoc.PageSetup.Orientation = wdOrientLandscape
objDoc.ActiveWindow.View.Type = wdNormalView

'set the doc range
objDoc.Range.Delete
Set rng = objDoc.Range

'iterate through the output array and add contents to document
For row = 1 To UBound(outputArray) - 1
'process page header
If Val(outputArray(row).sType) >= 1 And Val(outputArray(row).sType) <= 8 Then
processPageHeader outputArray, row, objDoc
Else
'process table data
processTable outputArray, row, objDoc
End If 'table or subhead

'Debug.Print "createTable loop row = " & row
Next row

End Sub
''''------------------------------------------------------------------

''''This subroutine inserts a page break and prints a page header. The only
thing to emphasize here is to remember to reset any font properties, which
has to be done after a paragraph break.

''''---------------------------------------------------------------------
Private Sub processPageHeader(outputArray() As CApdxB, row As Integer, _
objDoc As Word.Document)
'Private Sub processPageHeader(row As Integer, _
objDoc As Word.Document)
'table of heading data
Dim headingsTbl( As String
headingsTbl(1) = "B-1. Standards Compliance (Level 1)"
headingsTbl(2) = "B-2. Network Compliance (Level 2)"
headingsTbl(3) = "B-3. Platform Compliance (Level 3)"
headingsTbl(4) = "B-4. Bootstrap Compliance (Level 4)"
headingsTbl(5) = "B-5. Minimal DII Compliance (Level 5)"
headingsTbl(6) = "B-6. Intermediate DII Compliance (Level 6)"
headingsTbl(7) = "B-7. Interoperable Compliance (Level 7)"
headingsTbl( = "B-8. Full DII Compliance (Level "

'first page doesn't need a page break
If Val(outputArray(row).sType) > 1 Then
objDoc.ActiveWindow.Selection.InsertBreak wdPageBreak
End If

objDoc.ActiveWindow.Selection.Font.Bold = True
objDoc.ActiveWindow.Selection.Font.Size = 16
objDoc.ActiveWindow.Selection.TypeText Text:= _
headingsTbl(Val(Left$(outputArray(row).sType, 1)))
objDoc.ActiveWindow.Selection.TypeParagraph
objDoc.ActiveWindow.Selection.TypeParagraph
objDoc.ActiveWindow.Selection.Font.Bold = False
objDoc.ActiveWindow.Selection.Font.Size = 10
End Sub
'----------------------------------------------------------------
'
'The TypeParagraph command inserts a blank line and separates the selection
so changes to
'the font properties wont affect already printed text. If you change font
without an
'intervening paragraph, the changes affect the text that was just printed
'
'The following subroutine took the longest to work out. It creates a table
with four columns
'and an arbitrary number of rows. At irregular intervals, a table row will
'contain a subhead rather than table data. The subheads need to be centered
in a shaded box.
'The routine creates the table and sets the width of the columns, then it
fills the table cell-by-cell, moving to the right by one cell for each data
item. Of course, Word obligingly creates a new table row when the row above
is filled. Once the table is completely filled, the routine goes back to the
top of the table and scans down looking for a subhead entry. When it finds
one, it selects the entire row, merges the cells, centers the text, and sets
the font and background texture.
'
'-------------------------------------------------------------
'Private Sub processTable(row As Integer, _
'objDoc As Word.Document)
Private Sub processTable(outputArray() As CApdxB, row As Integer, _
objDoc As Word.Document)
Dim rowCount As Integer
Dim colCount As Integer
Dim ndx As Integer
Dim table As Word.table

'build the table
rowCount = 1
colCount = 4
Set table = objDoc.Tables.Add(objDoc.ActiveWindow.Selection.Range, _
rowCount, colCount)

table.Columns(1).Width = 45
table.Columns(2).Width = 45
table.Columns(3).Width = 280
table.Columns(4).Width = 280

'fill the cells
rowCount = 0
ndx = row
While outputArray(ndx).sType > "8" 'page headers are "1" thru "8"
objDoc.ActiveWindow.Selection.TypeText Text:=outputArray(ndx).sCompliance
objDoc.ActiveWindow.Selection.MoveRight Unit:=wdCell
'-------------------------------------------------------
'MoveRight tabs to the next cell.

objDoc.ActiveWindow.Selection.TypeText Text:=outputArray(ndx).sIndex
objDoc.ActiveWindow.Selection.MoveRight Unit:=wdCell
objDoc.ActiveWindow.Selection.TypeText Text:=outputArray(ndx).sText
objDoc.ActiveWindow.Selection.MoveRight Unit:=wdCell
objDoc.ActiveWindow.Selection.TypeText Text:=outputArray(ndx).sComments
objDoc.ActiveWindow.Selection.MoveRight Unit:=wdCell
ndx = ndx + 1
rowCount = rowCount + 1
Wend

'the last line of the table is blank; so delete it
objDoc.ActiveWindow.Selection.Cells.Delete ShiftCells:=wdDeleteCellsEntireRow

'move the selection back to the start of the table
objDoc.ActiveWindow.Selection.MoveUp Unit:=wdLine, Count:=rowCount
'-------------------------------------------------------------------
'Note: you have to still be in the table for the MoveUp to work right.
'-------------------------------------------------------------------
'find each of the subheaders and format that line
For ndx = row To row + rowCount
If outputArray(ndx).sType = "S" Then
'Debug.Print "Subheader for " & outputArray(ndx).sText

objDoc.ActiveWindow.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
objDoc.ActiveWindow.Selection.MoveRight Unit:=wdCharacter, Count:=3,
Extend:=wdExtend
objDoc.ActiveWindow.Selection.Cells.Merge
'------------------------------------------------------------------
'The three lines above select the entire row and merge the cells
'------------------------------------------------------------------
objDoc.ActiveWindow.Selection.Font.Size = 14
objDoc.ActiveWindow.Selection.Font.Bold = wdToggle
objDoc.ActiveWindow.Selection.ParagraphFormat.Alig nment =
wdAlignParagraphCenter
With objDoc.ActiveWindow.Selection.Cells
With .Shading
..Texture = wdTexture10Percent
End With
End With
'---------------------------------------------------------------------
'The With .Shading construct above applies the background pattern to the
selected line
'---------------------------------------------------------------------
objDoc.ActiveWindow.Selection.MoveRight Unit:=wdCell, Count:=2
'---------------------------------------------------------------------
'The third cell contained the text when I merged the row, so moving right
two cells moves from cell 3 to cell 4 and then to the first cell of the next
line.
'---------------------------------------------------------------------
Else
objDoc.ActiveWindow.Selection.MoveDown Unit:=wdLine, Count:=1
End If

Next ndx

'move out of the table
objDoc.ActiveWindow.Selection.MoveDown Unit:=wdLine, Count:=1
objDoc.ActiveWindow.Selection.TypeParagraph
'------------------------------------------------------------------
'Lastly, move down out of the table and insert a blank line before starting
the next page.
'-------------------------------------------------------------------
row = row + rowCount - 1

End Sub

Archived from group: microsoft>public>vb>ole>automation