Export From Excel Cells To Word Table (Revisited)

[RonMcK]

Hi, All,

I read the thread (Export From Excel Cells To Word Table (http://www.vbaexpress.com/forum/showthread.php?t=29201)) and have some questions. I have a Workbook with 5 worksheets; I want to transfer selected cells (columns) into separate Word tables/documents, one per worksheet.

1. When I pre-build the tables in the word docs, do I need to give each not only the number of columns but also the number of rows that it will need? Or, can I either build the tables or add rows programmatically?

2. I'm puzzled about where I am to place the code, does it go in the Word doc or in the Excel doc? If in the Word doc, where does the excel doc get identified and opened? I don't believe I see that happening in any of the several VBA programs listed.

3. Can I have my VBA code iterate through the 5 worksheets in my workbook handling it all in one 'run'?

4. In addition to the code in the source thread, are there any examples of this type of VBA program (or code) in the articles or KB, here? My quick search failed to turn any up, but I may have used the wrong key words.

5. I've worked with VBA in Excel but am just venturing into using it in/with Word.

Thanks,

[Dave]

Here's some more XL/Word table stuff. http://www.vbaexpress.com/forum/showthread.php?t=17784
1) Yes you can adjust the Word tables from XL or just add the whole table from XL
2) XL code. See the link
3) Yes
4) There's info out there
5) HTH. Dave

[RonMcK]

Thanks, Dave. I'll work with all of this in a little bit. I'll report back on my success.

Cheers,

[RonMcK3]

Dave,

Here is a snipped from the code you posted early in your conversation with Ioncila. Below are my questions.
Sub XLToWordTable()
Dim ObjWord As Object, Rng As Range
Dim wrdDoc As Object, Ocell As Variant, TC As Variant
Dim Lastrow As Integer, Lastcol As Integer, Cnt As Integer

' <snip> removed some material

'set XL range to suit
'determine table sixe from Xl range (used range in this eg.)
Lastrow = Sheets("Sheet1").UsedRange.Rows.Count
Lastcol = Sheets("Sheet1").UsedRange.Columns.Count

'vba set XL range
With Sheets("Sheet1")
Set Rng = .Range(.Cells(1, 1), .Cells(Lastrow, Lastcol))
End With
'insert XL cell.value to table location
'table(1) in this example (ie change table to suit)
Cnt = 1
For Each Ocell In Rng
Set TC = ObjWord.ActiveDocument.Tables(1).Range.Cells(Cnt)
TC.Range.InsertAfter Ocell.Value
Cnt = Cnt + 1
Next Ocell

' <snip> deleted remainder of code
End Sub

I see that you set rng equal to the rectangle of cells from 1,1 to lastrow, lastcolumn.

FOR EACH ocell IN rng / NEXT ocell block populates the cells in the Word table without your needing to use nested FOR/NEXT loops to walk through the rows and columns of the Excel table. Am I reading your code properly?

If I want to write only selected cells from each Excel table row, I assume that I will need to use those nested FOR/NEXT or DO WHILE/LOOP constructions for reading the Excel data. Can I use the same loops for placing the data in the Word table or do I need to still use the FOR EACH/NEXT construction for picking the Word table cell to write in?

Thanks,

[lucas]

Ron, can you run this from Excel?

[Dave]

I believe that you are reading the code correctly. You can assign specific XL cells to specific Word tables cells (see below). This is XL code. HTH. Dave

Sub XLToWordTable_2()
Dim ObjWord As Object
Dim wrdDoc As Object

On Error GoTo ErFix
'Set the Word Object
Set ObjWord = CreateObject("Word.Application")


Set wrdDoc = ObjWord.Documents.Open(Filename:="D:\test.doc")

'If there is more than one
'table, but sure to change it here.
With wrdDoc.Tables(1)
.Cell(1, 1) = Sheets("Sheet1").Cells(1, "A")
.Cell(1, 2) = Sheets("Sheet1").Cells(2, "B")
'etc
End With

wrdDoc.Close savechanges:=False
Set wrdDoc = Nothing
ObjWord.Quit
Set ObjWord = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "error"
Set wrdDoc = Nothing
ObjWord.Quit
Set ObjWord = Nothing
End Sub

[RonMcK]

Ron, can you run this from Excel?
Yes, I believe I can. I've run other of Dave's code in XL; I'm trying to work out how I want to do my code beforehand (for a change) instead of spending 95 hours trying and not getting what I want until the umpteenth iteration. :yes

I haven't forgotten that I owe you a photograph. I'll try to get that done in the next week or so.

Thanks,

[RonMcK]

Dave,

I assume, if I want to iterate the process through 5 instances of a table (each one on a separate XL sheet) and place non-adjacent cells from the XL table into my Word table, that I'll need to do something like the following?

Sub XLToWordTable_2()
Dim ObjWord As Object
Dim wrdDoc As Object
Dim LastRow As Long, FirstRow As Long, XLrow As Long, wdRow As Long
'Dim LastCol As Long, FirstCol As Long, XLcol As Long, wdCol As Long
Dim GradeNum As String, Grade As Integer, MaxGrade As Integer

FirstRow = 5
FirstCol = 1
Grade = 1
MaxGrade = 5

On Error GoTo ErFix
'Set the Word Object
Set ObjWord = CreateObject("Word.Application")

While Grade <= MaxGrade
GradeNum = "Grade" & String(Grade, "0")
Set wrdDoc = ObjWord.Documents.Open(Filename:="D:\" & GradeNum & ".doc")

'set XL range to suit
'determine table sixe from Xl range (used range in this eg.)
LastRow = Sheets(GradeNum).UsedRange.Rows.Count
' LastCol = Sheets(GradeNum).UsedRange.Columns.Count

'If there is more than one
'table, but sure to change it here.
With wrdDoc.Tables(1)
For XLrow = FirstRow To LastRow Step 1
wdRow = XLrow - FirstRow + 1
.Cell(wdRow, 1) = Sheets("Sheet1").Cells(XLrow, "A")
.Cell(wdRow, 2) = Sheets("Sheet1").Cells(XLrow, "B")
'etc
Next XLrow
End With

wrdDoc.Close savechanges:=False
Set wrdDoc = Nothing
Grade = Grade + 1
Loop

ObjWord.Quit
Set ObjWord = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "error"
Set wrdDoc = Nothing
ObjWord.Quit
Set ObjWord = Nothing
End Sub


Thanks,

[Dave]

Not sure of your loop logic and I don't see any sheet changing? Is all of the XL data going to the same Word table? Whoops..this line should be...

wrdDoc.Close savechanges:=True

Dave
ps. perhaps...

.Cell(wdRow, 1) = Sheets(gradenum).Cells(XLrow, "A")

[RonMcK3]

Not sure of your loop logic and I don't see any sheet changing? Is all of the XL data going to the same Word table? Whoops..this line should be...

wrdDoc.Close savechanges:=True
Dave
ps. perhaps...

.Cell(wdRow, 1) = Sheets(gradenum).Cells(XLrow, "A")

Dave,

How right you are. I forgot to change that sheet name reference. Thanks for fixing the 'save'.

If I use the alternative of having my code open a new file, how do I get the code to name it and save it? Here is TinBendr's code for creating the file and a table within it; I've added the code I believe I need to name and save the file.
Sub AddTable2()
'Create new doc and table
Dim oWDBasic As Object
Dim wrdDoc As Object

Set oWDBasic = CreateObject("Word.Application")
Set wrdDoc = oWDBasic.Documents.Add
oWDBasic.Visible = True

'add table to doc
With wrdDoc
.Tables.Add oWDBasic.Selection.Range, numrows:=20, Numcolumns:=5, AutoFitBehavior:= _
wdAutoFitFixed
End With
'do whatever I want to do with and to the Table

'then save the file
' QUERY: Should I do a SaveAs immediately after creating the file or just wait until I'm done working in it?
With wrdDoc
.SaveAs FileName:="C:\Users\Ron\My Documents\Grade 1\Glossary Grade 1.doc", _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True
End With

Set wrdDoc = Nothing
Set oWDBasic = Nothing
End Sub

[Dave]

Just use...

wrdDoc.SaveAs "C:\Users\Ron\My Documents\Grade 1\Glossary Grade 1.doc" 'etc
wrdDoc.Close savechanges:=False
Set wrdDoc = Nothing

Dave
ps. we had an interesting chat re. the use of oWDBasic here somewhere re. not referring to Word Basic when naming Word object variables. I'll see if I can find a link

[RonMcK]

Thanks, Dave. BTW, roughly where in BC are you located?

Cheers,

[RonMcK]

ps. we had an interesting chat re. the use of oWDBasic here somewhere re. not referring to Word Basic when naming Word object variables. I'll see if I can find a link
That threw me for a few minutes when I was first looking at the code. I suspect that something like objWord might be less confusing.

Thanks,

[Dave]

Not in BC. Live on the eastern prairies in Manitoba where it's getting cold. Here's the link. Have a nice day. Dave

http://www.vbaexpress.com/forum/showthread.php?t=28845

[RonMcK3]

Dave,

Thanks for the reference to your earlier thread and the help Fumei and macropod gave you (plus a peep from geekgirlau).

I think I remember BC from Fumei and misapplied it to you. Enjoy the Polar Arctic blasts this winter.

Cheers,

[RonMcK]

Dave, et al,

I have a couple of more questions which I have included in the following code that I grabbed using the macro recorder.
Sub RonsSimpleBoxTable3()
'
' RonsSimpleBoxTable2 Macro
'
' When I build my table, I want a solid grid and I need to build the macro so it will
' work on my WinXP/XL&Word2003 desktop PC at work. My questions are in the code below
' as comments.
'
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=20, NumColumns _
:=5, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
'/. Why use the above construction instead of the following, which is simple:
.Style = "Table Grid"
'/. Do I really need any or all of the following ApplyStyle... assignments?
' .ApplyStyleHeadingRows = True
' .ApplyStyleLastRow = False
' .ApplyStyleFirstColumn = True
' .ApplyStyleLastColumn = False
' .ApplyStyleRowBands = True
' .ApplyStyleColumnBands = False
End With
' ActiveDocument.SaveAs FileName:="RonsSimpleBoxTable.doc", FileFormat:= _
' wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
' True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
' False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
' SaveAsAOCELetter:=False
'/. Can I simplify the above to the following?
ActiveDocument.SaveAs FileName:="RonsSimpleBoxTable3.doc", FileFormat:= _
wdFormatDocument
'/.
'/. I believe the answer to each of the above questions is yes since I ran this
'/. code and have the gird I'm looking for.
'/. Am I missing anything?
End Sub

Thanks for your assistance.

Cheers,

[Dave]

There's some table formating stuff here. I don't think the file format stuff is needed when you save. I'm sure et al. will be more able to help with this. Dave
http://www.vbaexpress.com/forum/showthread.php?t=17784

[RonMcK]

Dave, et al,

Here's the code I ended up using and it worked very smoothly.
Sub XLToWordTable()
Dim ObjWord As Object, Rng As Range
Dim wrdDoc As Object, Ocell As Variant, TC As Variant
Dim LastRow As Long, LastCol As Long, Cnt As Long
Dim FirstRow As Long, FirstCol As Long
Dim Grade As Integer, MaxGrade As Integer, Sht As Integer
Dim GradeNum As String
Sht = 1
MaxGrade = 5
FirstRow = 5
Set oWDBasic = CreateObject("Word.Application")
Do While Sht > 0 And Sht <= MaxGrade
GradeNum = "Grade " & Trim(Str(Sht))
Sheets(GradeNum).Select
'set XL range to suit
'determine table size from Xl range (used range in this eg.)
LastRow = Sheets(GradeNum).UsedRange.Rows.Count
LastCol = Sheets(GradeNum).UsedRange.Columns.Count

Set wrdDoc = oWDBasic.Documents.Add
oWDBasic.Visible = True
'add text to top of doc and spaces before table
oWDBasic.ActiveDocument.Select
With oWDBasic.Selection
.typetext Text:="Glossary" & vbCrLf
.typetext Text:=GradeNum & vbCrLf
.typeparagraph
.typeparagraph
End With

'add table
wrdDoc.Tables.Add oWDBasic.Selection.Range, numrows:=LastRow - 4, Numcolumns:=LastCol

'vba set XL range
Set Rng = Sheets(GradeNum).Range(ActiveSheet.Cells(FirstRow, 1), ActiveSheet.Cells(LastRow, LastCol))
'insert XL cell.value to table location
'table(1) in this example (ie change table to suit)
Cnt = 1
For Each Ocell In Rng
Set TC = oWDBasic.ActiveDocument.Tables(1).Range.Cells(Cnt)
TC.Range.InsertAfter Ocell.Value
Cnt = Cnt + 1
Next Ocell

With wrdDoc
.SaveAs Filename:="C:\Documents and Settings\mckenzier\My Documents\Glossary\" & GradeNum & ".doc", _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True
.Close savechanges:=False
Set wrdDoc = Nothing
End With

Sht = Sht + 1
Loop

Set wrdDoc = Nothing
Set oWDBasic = Nothing
End Sub


Thanks for your advice and assistance,

[Dave]

Thanks for posting your outcome. This code probably isn't needed if you are saving and closing the doc. Have a nice day. Dave

oWDBasic.Visible = True

[oleg_v]

HI
IF I HAVE THE TABLES ALREADY SET IN THE WORD DOCUMENT
HOW CAN TRANSFER THE DATA FROM A SINGLE CELL TO SINGLE CELL IN THE WORD TABLE

THANKS

[Dave]

Hi oleg. Please stop shouting with those capitals :) Providing a link to other relevant threads is also usually handy. It may have been better to start a new thread here. HTH. Dave

Sub XLToWordTable_3()
Dim ObjWord As Object
Dim wrdDoc As Object

On Error GoTo ErFix
'Set the Word Object
Set ObjWord = CreateObject("Word.Application")

'Create a Document based on the template TableTest.dot
'You'll need to create the template ahead of time.
Set wrdDoc = ObjWord.Documents.Open(Filename:="D:\test.doc")

'If there is more than one
'table, but sure to change it here.
With wrdDoc.Tables(1)
.Cell(1, 1) = CStr(Sheets("Sheet1").Range("A" & 1).Value)
.Cell(1, 2) = CStr(Sheets("Sheet1").Range("B" & 1).Value)
'etc.
End With

'close and save .doc
wrdDoc.SaveAs "D:\TEST.DOC" 'change file name to suit
wrdDoc.Close savechanges:=False
Set wrdDoc = Nothing
ObjWord.Quit
Set ObjWord = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "error"
Set wrdDoc = Nothing
ObjWord.Quit
Set ObjWord = Nothing
End Sub

ps. post #6 in this thread addresses this (without the CStr)

[RonMcK]

HI
IF I HAVE THE TABLES ALREADY SET IN THE WORD DOCUMENT
HOW CAN TRANSFER THE DATA FROM A SINGLE CELL TO SINGLE CELL IN THE WORD TABLE
Oleg,

Please look at Dave's reply to me (above) of 12-02-2009 09:39 PM. You can probably get what you want by working with this snippet of code:

'If there is more than one
'table, but sure to change it here.
With wrdDoc.Tables(1)
.Cell(1, 1) = Sheets("Sheet1").Cells(1, "A")
.Cell(1, 2) = Sheets("Sheet1").Cells(2, "B")
'etc
End With

Cheers,