add second table to word document and more text

M

megatronixs

Registered User.
Local time
Today, 21:19
Joined
Aug 17, 2012
Messages
719
Hi all,

I managed to create some code today that will create a word document, add some text from and a table with text in it.

I can create the word doc with text, and I can create the word doc with the table. What I'm not able, is to combine them both so I will get the first part with text, then add the table with the text, add text below the table, and then add second table that will be more or less like the first table.

in the current version, it adds the text as it should, but then the table gets on top of the text and only the table will be visible.
Adding the second table is also impossible.
Below is the code I have so far:
Code: 
Private Sub btn_create_word_check_list_Click()
Dim objWord As Word.Application
Dim doc As Word.Document
Dim WordHeaderFooter As HeaderFooter
Dim objDoc
   Dim objRange
   Dim objTable
   Dim intNoOfRows
   Dim intNoOfColumns
intNoOfRows = 5
 intNoOfColumns = 6
 
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
 
With objWord
    .Visible = True
    Set doc = .Documents.Add
    doc.SaveAs "C:\My DOcuments\Check List Docs\TestDoc.doc"
End With
 
With objWord.Selection
 .Font.Name = "Calibri"
 .Font.Size = 10
 
  .TypeText "process check list"
    .TypeParagraph
    .TypeParagraph
 
  .TypeText "BIN / Customer " & Me.BIN & " - " & Me.LE_Name
    .TypeParagraph
    .TypeParagraph
    .TypeParagraph
 
  .TypeText "Analyst Checklist"
  .TypeParagraph
 
    'Add header and footer
    ActiveDocument.Sections(1).headers(wdHeaderFooterPrimary).Range.Text = "Header"
    ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Footer"
 
'====================================================
'   Add the table after the above text
'====================================================
    Set objRange = doc.Range
.Font.Name = "Calibri"
 .Font.Size = 10
objRange.Tables.Add objRange, intNoOfRows, intNoOfColumns
Set objTable = doc.Tables(1)
objTable.Borders.Enable = True
 
'Column 1
objTable.Cell(1, 2).Range.Text = "1st year"
objTable.Cell(2, 1).Range.Text = "Date check complete"
objTable.Cell(2, 2).Range.Text = Date
objTable.Cell(3, 1).Range.Text = "SPI (Special Instructions)"
objTable.Cell(3, 2).Range.Text = GetUserName
objTable.Cell(4, 1).Range.Text = "NO Op's No Operations"
objTable.Cell(4, 2).Range.Text = GetUserName
objTable.Cell(5, 1).Range.Text = "Double Check"
objTable.Cell(5, 2).Range.Text = "(Insert Name)"
'Column 2
objTable.Cell(1, 3).Range.Text = "2nd year"
objTable.Cell(2, 3).Range.Text = "00/00/0000"
objTable.Cell(3, 3).Range.Text = "(Insert Name)"
objTable.Cell(4, 3).Range.Text = "(Insert Name)"
objTable.Cell(5, 3).Range.Text = "(Insert Name)"
 
'Column 3
objTable.Cell(1, 4).Range.Text = "3rd year"
objTable.Cell(2, 4).Range.Text = "00/00/0000"
objTable.Cell(3, 4).Range.Text = "(Insert Name)"
objTable.Cell(4, 4).Range.Text = "(Insert Name)"
objTable.Cell(5, 4).Range.Text = "(Insert Name)"
'Column 4
objTable.Cell(1, 5).Range.Text = "4th year"
objTable.Cell(2, 5).Range.Text = "00/00/0000"
objTable.Cell(3, 5).Range.Text = "(Insert Name)"
objTable.Cell(4, 5).Range.Text = "(Insert Name)"
objTable.Cell(5, 5).Range.Text = "(Insert Name)"
'Column 5
objTable.Cell(1, 6).Range.Text = "5th year"
objTable.Cell(2, 6).Range.Text = "00/00/0000"
objTable.Cell(3, 6).Range.Text = "(Insert Name)"
objTable.Cell(4, 6).Range.Text = "(Insert Name)"
objTable.Cell(5, 6).Range.Text = "(Insert Name)"
 
End With
 
'End With
 
'====================================================
'   Add 1 line of text after the above table
'====================================================
.TypeText "Analyst Checklist"
 
'====================================================
'   Add next table after the above Text with also 5 rows and 6 columns
'====================================================
 
doc.Save
doc.Activate
 
End Sub

Hope some one can help out :-)

Greetings.
 
I was getting errors running your code if I ran it more than once. I was telling me the remote server wasn't available. To get rid of that error I changed

Code: 
   ActiveDocument.Sections(1).headers(wdHeaderFooterPrimary).Range.Text = "Header"
    ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Footer"

to

Code: 
doc.Sections(1).headers(wdHeaderFooterPrimary).Range.Text = "Header"
doc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Footer"


I think it's better not to use the ActiveDocument object. I've alway had problems with it.

Anyway to the posted problem I found it useful to have a selection object. I suggest adding one in your declarations like
Code: 
Dim sel As Word.Selection

The set it after

Code: 
With objWord
    .Visible = True
    Set doc = .Documents.Add
    doc.SaveAs "C:\Users\sneuberg\Desktop\TestDoc.doc"
End With

with

Code: 
Set sel = objWord.Selection

you can then move the cursor to the end of the document with

Code: 
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.Collapse

And then add some text with

Code: 
sel.InsertAfter "Some text"

There's a property for tables that you can set that determines how they interact with text on the page, i.e., flow with it, around it, on top, etc. I can't find it right now but I'll keep looking and let you know.
 
You can set the properties you normally would set here

attachment.php


With statements like:

Code: 
objTable.Rows.WrapAroundText = True
objTable.Rows.Alignment = wdAlignRowLeft

I have another suggest concerning your code. That is to change the declarations

Code: 
Dim objRange
Dim objTable

to
Code: 
Dim objRange As Word.Range
Dim objTable As Word.Table

to get the benefit of the Intellisense.
 

Attachments

  • Table Props.jpg
    Table Props.jpg
    37.3 KB · Views: 627
Hi,

Thanks a lot for the code, I will be going through this right now and see if I can manage. Once I fix it, I will post back :-)

Greetings.
 
Hi,

I just don't get the code working for adding the table below the first text.
It is just replacing the text with the table
What is working is the adding text after the table.

I guess I go somewhere wrong after the text just before the table gets inserted
somehow I need to pass the place the table should start.

Greetings.
 
Hi,

Made some progress. I made some changes, added a bookmark and then at the bookmark it inserts the table.

Code: 
'====================================================
'   Add the table after the above text
'====================================================
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.collapse
sel.MoveDown
    Set objRange = doc.Range
.Font.Name = "Calibri"
 .Font.Size = 10
sel.bookmarks.Add Name:="Table"
 Set objRange = sel.bookmarks("Table").Range
 
objRange.Tables.Add objRange, intNoOfRows, intNoOfColumns
Set objTable = doc.Tables(1)
objTable.Borders.Enable = True


All works fine, but only for 1 table and when I duplicate the code to add the second table below the text "2nd leved Checker" is replaced just by the table

Code: 
'====================================================
'   Add 1 line of text after the above table
'====================================================
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.collapse
sel.TypeParagraph
sel.TypeParagraph
sel.InsertAfter "2nd leved Checker"
sel.TypeParagraph


Code: 
'====================================================
'   Add next table after the above Text
'====================================================
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.collapse
sel.MoveDown
    Set objRange2 = doc.Range
sel.bookmarks.Add Name:="Table2"
 Set objRange2 = sel.bookmarks("Table2").Range
objRange2.Tables.Add objRange2, intNoOfRows, intNoOfColumns
Set objTable2 = doc.Tables(1)
objTable2.Borders.Enable = True
'Column 1
objTable2.Cell(1, 2).Range.Text = "1st year"

Any clue how to solve the last part?

Greetings.
 
Hi all,

I managed to solve it and now it is working fine :-)

Code: 
Private Sub btn_create_word_check_list_Click()
    Dim objWord As Word.Application
    Dim doc As Word.Document
    Dim WordHeaderFooter As HeaderFooter
    Dim objDoc
    Dim objRange As Word.Range
    Dim objTable As Word.Table
    Dim sel As Word.Selection
    Dim intNoOfRows
    Dim intNoOfColumns
        intNoOfRows = 5
        intNoOfColumns = 6
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
 
With objWord
    .Visible = True
    Set doc = .Documents.Add
    doc.SaveAs "C:\My DOcuments\Check List Docs\TestDoc.doc"
End With
Set sel = objWord.Selectio
 With objWord.Selection
 .Font.Name = "Calibri"
 .Font.Size = 10
 
  .TypeText "process check list"
    .TypeParagraph
    .TypeParagraph
 
  .TypeText "BIN / Customer " & Me.BIN & " - " & Me.LE_Name
    .TypeParagraph
    .TypeParagraph
    .TypeParagraph
 
  .TypeText "Analyst Checklist"
  .TypeParagraph
 
    'Add header and footer
    doc.Sections(1).headers(wdHeaderFooterPrimary).Range.Text = "Header"
    doc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Footer"
 
'====================================================
'   Add the table after the above text
'====================================================
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.collapse
sel.MoveDown
    Set objRange = doc.Range
.Font.Name = "Calibri"
 .Font.Size = 11
sel.bookmarks.Add Name:="Table"
 Set objRange = sel.bookmarks("Table").Range
 
objRange.Tables.Add objRange, intNoOfRows, intNoOfColumns
Set objTable = doc.Tables(1)
objTable.Borders.Enable = True
 
'Column 1
objTable.Cell(1, 2).Range.Text = "1st year"
objTable.Cell(2, 1).Range.Text = "Date check complete"
objTable.Cell(2, 2).Range.Text = Date
objTable.Cell(3, 1).Range.Text = "SPI (Special Instructions)"
objTable.Cell(3, 2).Range.Text = GetUserName
objTable.Cell(4, 1).Range.Text = "NO Op's No Operations"
objTable.Cell(4, 2).Range.Text = GetUserName
objTable.Cell(5, 1).Range.Text = "Double Check"
objTable.Cell(5, 2).Range.Text = "(Insert Name)"
'Column 2
objTable.Cell(1, 3).Range.Text = "2nd year"
objTable.Cell(2, 3).Range.Text = "00/00/0000"
objTable.Cell(3, 3).Range.Text = "(Insert Name)"
objTable.Cell(4, 3).Range.Text = "(Insert Name)"
objTable.Cell(5, 3).Range.Text = "(Insert Name)"
 
'Column 3
objTable.Cell(1, 4).Range.Text = "3rd year"
objTable.Cell(2, 4).Range.Text = "00/00/0000"
objTable.Cell(3, 4).Range.Text = "(Insert Name)"
objTable.Cell(4, 4).Range.Text = "(Insert Name)"
objTable.Cell(5, 4).Range.Text = "(Insert Name)"
'Column 4
objTable.Cell(1, 5).Range.Text = "4th year"
objTable.Cell(2, 5).Range.Text = "00/00/0000"
objTable.Cell(3, 5).Range.Text = "(Insert Name)"
objTable.Cell(4, 5).Range.Text = "(Insert Name)"
objTable.Cell(5, 5).Range.Text = "(Insert Name)"
'Column 5
objTable.Cell(1, 6).Range.Text = "5th year"
objTable.Cell(2, 6).Range.Text = "00/00/0000"
objTable.Cell(3, 6).Range.Text = "(Insert Name)"
objTable.Cell(4, 6).Range.Text = "(Insert Name)"
objTable.Cell(5, 6).Range.Text = "(Insert Name)"
 
End With
 
 
'====================================================
'   Add 1 line of text after the above table
'====================================================
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.collapse
sel.TypeParagraph
sel.TypeParagraph
sel.InsertAfter "2nd lever Checker"
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
sel.collapse
 
'====================================================
'   Add next table after the above Text with also 5 rows and 6 columns
'====================================================
 
sel.EndOf wdStory, wdMove   'Move the cursor to the end of the document
    sel.collapse
        sel.TypeParagraph
sel.MoveDown
    Set objRange2 = doc.Range
sel.bookmarks.Add Name:="Table2"
 Set objRange = sel.bookmarks("Table2").Range
objRange.Tables.Add objRange, intNoOfRows, intNoOfColumns
    Set objTable = doc.Tables(2)
        objTable.Borders.Enable = True
'Column 1
objTable.Cell(1, 2).Range.Text = "1st year"
objTable.Cell(2, 1).Range.Text = "Date check complete"
objTable.Cell(2, 2).Range.Text = Date
objTable.Cell(3, 1).Range.Text = "SPI (Special Instructions)"
objTable.Cell(3, 2).Range.Text = GetUserName
objTable.Cell(4, 1).Range.Text = "NO Op's No Operations"
objTable.Cell(4, 2).Range.Text = GetUserName
objTable.Cell(5, 1).Range.Text = "Double Check"
objTable.Cell(5, 2).Range.Text = "(Insert Name)"
'Column 2
objTable.Cell(1, 3).Range.Text = "2nd year"
objTable.Cell(2, 3).Range.Text = "00/00/0000"
objTable.Cell(3, 3).Range.Text = "(Insert Name)"
objTable.Cell(4, 3).Range.Text = "(Insert Name)"
objTable.Cell(5, 3).Range.Text = "(Insert Name)"
 
'Column 3
objTable.Cell(1, 4).Range.Text = "3rd year"
objTable.Cell(2, 4).Range.Text = "00/00/0000"
objTable.Cell(3, 4).Range.Text = "(Insert Name)"
objTable.Cell(4, 4).Range.Text = "(Insert Name)"
objTable.Cell(5, 4).Range.Text = "(Insert Name)"
'Column 4
objTable.Cell(1, 5).Range.Text = "4th year"
objTable.Cell(2, 5).Range.Text = "00/00/0000"
objTable.Cell(3, 5).Range.Text = "(Insert Name)"
objTable.Cell(4, 5).Range.Text = "(Insert Name)"
objTable.Cell(5, 5).Range.Text = "(Insert Name)"
'Column 5
objTable.Cell(1, 6).Range.Text = "5th year"
objTable.Cell(2, 6).Range.Text = "00/00/0000"
objTable.Cell(3, 6).Range.Text = "(Insert Name)"
objTable.Cell(4, 6).Range.Text = "(Insert Name)"
objTable.Cell(5, 6).Range.Text = "(Insert Name)"
 
doc.Save
doc.Activate
 
End Sub
 
Glad you got it. Thanks for posting it. I'll look at it later to see what I can learn from it.
 
You must log in or register to reply here.

Similar threads

K
Adding and Deleting records in a junction table.
Replies
3
Views
282
KitaYama
K
D
Subform only shows single record
Replies
3
Views
287
arnelgp
arnelgp
I
Create and training record database
Replies
8
Views
752
Pat Hartman
P
H
Solved Case Statement to get value in Access Query
Replies
15
Views
1,457
Pat Hartman
P
P
Reading a long text file to insert rows in a table
Replies
8
Views
671
pacctono
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom