Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

Creating Word Tables from VB6.0

bhammondbhammond Posts: 7Member
I've written a VB app that creates a Word report. The basic format of the
report is





etc.

Everything works fine until I try to create the second table. The insertion point is still in the first cell of the first table, and I get a run-time error 5962 "there is already a table at this position." I think the problem is with the value in the Range object, but I can't seem to change it. Any suggestions?

Thanks,

Comments

  • dokken2dokken2 Posts: 532Member
    : I've written a VB app that creates a Word report. The basic format of the
    : report is
    :
    :
    :
    :
    :
    :
    :
    : etc.
    :
    : Everything works fine until I try to create the second table. The insertion point is still in the first cell of the first table, and I get a run-time error 5962 "there is already a table at this position." I think the problem is with the value in the Range object, but I can't seem to change it. Any suggestions?
    :
    : Thanks,
    :
    :
    Since you have table data, would Excel be a more intuitive method? Its fairly straight forward to automate inserting records into the worksheet cells. just a thought.

  • bhammondbhammond Posts: 7Member
    : Since you have table data, would Excel be a more intuitive method? Its fairly straight forward to automate inserting records into the worksheet cells. just a thought.
    :
    :
    Yeah, I did that one first. My problem there was getting wordwrap in the cells. I may have to go back to it, but I'd like to figure this one out,too.




  • doofusboydoofusboy Posts: 256Member
    : : Since you have table data, would Excel be a more intuitive method? Its fairly straight forward to automate inserting records into the worksheet cells. just a thought.
    : :
    : :
    : Yeah, I did that one first. My problem there was getting wordwrap in the cells. I may have to go back to it, but I'd like to figure this one out,too.
    :
    :
    :
    :
    :
    Try going into Word [or Excel], select Tools - Macro - Record New Macro from the menu, then do what you want to do manually. Then stop recording and edit the macro to see the code.
  • bhammondbhammond Posts: 7Member
    : : : Since you have table data, would Excel be a more intuitive method? Its fairly straight forward to automate inserting records into the worksheet cells. just a thought.
    : : :
    : : :
    : : Yeah, I did that one first. My problem there was getting wordwrap in the cells. I may have to go back to it, but I'd like to figure this one out,too.
    : :
    : :
    : :
    : :
    : :
    : Try going into Word [or Excel], select Tools - Macro - Record New Macro from the menu, then do what you want to do manually. Then stop recording and edit the macro to see the code.
    :



  • bhammondbhammond Posts: 7Member
    : : : : Since you have table data, would Excel be a more intuitive method? Its fairly straight forward to automate inserting records into the worksheet cells. just a thought.
    : : : :
    : : : :
    : : : Yeah, I did that one first. My problem there was getting wordwrap in the cells. I may have to go back to it, but I'd like to figure this one out,too.
    : : :
    : : :
    : : :
    : : :
    : : :
    : : Try going into Word [or Excel], select Tools - Macro - Record New Macro from the menu, then do what you want to do manually. Then stop recording and edit the macro to see the code.
    : :
    That did it! Thanks. Here's the final code if anyone's interested:
    This is the main processing subroutine. It creates the Word application and document. Code is inside the boxes; comments are outside.
    ----------------------------------------------------------
    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
    ------------------------------------------------------------------
    As a strange aside note the line objWord.Visible = True above, which opens Word and makes it visible on the monitor. With this line occurring before processing begins, everything works correctly. If its moved to the bottom of the subroutine (after the processing loop), the process fails.

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

    I need to merge cells at certain points in the table where I want to insert table subheads. The subheads are identified with a special character in one field of the data array; so my routine loops through the data array until I find that character, but I need to synchronize scrolling through the array with scrolling through the Word table. However, in Page View, when a table cell extends across a page break, Word counts it as two cells. In Normal View, that doesnt happen. Thus the line above that sets the view to Normal.

    ----------------------------------------------------------------
    '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)

    'table of heading data
    Dim headingsTbl(8) 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(8) = "B-8. Full DII Compliance (Level 8)"

    '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(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.Alignment = 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
    -------------------------------------------------------------------
    There are undoubtedly different possibly better ways to solve the problem, but this one works; so Im content. Thanks, all for the help.




Sign In or Register to comment.