PDA

View Full Version : Excel to Word Insert Table Help!!



psctornado
03-23-2013, 07:26 AM
Hi All!

I was looking to see if I could get some help on how to insert a table into using WordApp. Attached is a simple sample of what I'm trying to do. Of course the amounts will change, but the headers will always be the same, and the amount of rows may vary depending on how many overpayments or underpayments may occur. I am trying to stay away from doing a mail merge since I find this to be a 'cleaner' way of generating lit through Excel.

I've looked around the forums a bit, but can't really make sense of some of the help with similar issues.

My knowledge on VBA is a tad limited, but if anyone could provide some help that would be appreciated.

Thanks!
:dunno

Dave
03-23-2013, 10:07 AM
This should get you started. HTH. Dave
http://www.vbaexpress.com/forum/showthread.php?t=17784

psctornado
03-23-2013, 11:33 AM
This should get you started. HTH. Dave
http://www.vbaexpress.com/forum/showthread.php?t=17784

Thanks Dave!

I tried to look at what was referenced in that link, but it keeps bugging out when I've adjusted the code. Is there another way perhaps to modify my sample?

Thanks!:help

Dave
03-23-2013, 02:05 PM
I usually don't look at files but it's a boring Saturday afternoon. You need to set up your XL sheet so that data for each column is only in 1 column (ie. You have $ 120.00 taking up 3 columns instead of 1.. just right click the cell/range and hit format cells). Anyways, this might provide a better starting point for you. This code refers to a "test" folder on the "C" drive...adjsut to suit. You can insert this in sheet code and then call the macro. Good luck. Dave
Sub XLWordTable2()
Dim AppWD As Object, wrdDoc As Object
Dim Rowtot As Integer, Coltot As Integer, Cnt As Integer
'adds text & table to Word doc from XL
'no Word reference required
On Error GoTo ErFix
Set AppWD = CreateObject("Word.Application")
'open existing word doc file ie. "C:\test\test.doc"
'Set wrdDoc = AppWD.Documents.Open(Filename:="C:\test\test.doc")
'open new doc
Set wrdDoc = AppWD.Documents.Add
'AppWD.Visible = True
'clear doc
' With wrdDoc
' .Range(0, .Characters.Count).Delete
'End With
AppWD.activedocument.Select
With AppWD.Selection
.Font.Size = 11
.Font.Bold = True
.Font.Name = "Times New Roman"
.typetext Text:=CStr(Sheets("lit").Range("AB" & 1))
.typeparagraph
.typetext Text:=CStr(Sheets("lit").Range("AB" & 2))
.typeparagraph
.typetext Text:=CStr(Sheets("lit").Range("AB" & 3))
.typeparagraph
.typetext Text:=CStr(Sheets("lit").Range("AB" & 4))
.typeparagraph
End With
'add table
Coltot = 4
With Sheets("lit")
lastrow = .Range("c" & .Rows.Count).End(xlUp).Row
End With
Rowtot = lastrow - 18
With wrdDoc
.Tables.Add AppWD.Selection.Range, numrows:=Rowtot, Numcolumns:=Coltot
.Tables(1).cell(1, 1).Range = CStr(Sheets("lit").Range("c" & 19))
.Tables(1).cell(1, 2).Range = CStr(Sheets("lit").Range("m" & 19))
.Tables(1).cell(1, 3).Range = CStr(Sheets("lit").Range("t" & 19))
.Tables(1).cell(1, 4).Range = CStr(Sheets("lit").Range("aa" & 19))
For Cnt = 2 To Rowtot
.Tables(1).cell(Cnt, 1).Range = CStr(Sheets("lit").Range("c" & 18 + Cnt))
.Tables(1).cell(Cnt, 2).Range = CStr(Sheets("lit").Range("o" & 18 + Cnt))
.Tables(1).cell(Cnt, 3).Range = CStr(Sheets("lit").Range("v" & 18 + Cnt))
.Tables(1).cell(Cnt, 4).Range = CStr(Sheets("lit").Range("ab" & 18 + Cnt))
Next Cnt
End With
'autoformat table
'table autoformat #'s 0 to 42 'ie. exchange 13 for 0 to 42
AppWD.activedocument.Tables(1).AutoFormat Format:=13, _
ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
'autofit table cell contents
With AppWD.activedocument.Tables(1)
.Columns.AutoFit
End With
'make text string with space following table
Dim Txtstr As String
Txtstr = vbCrLf & "Test finished at: " & Now()
'add text string after table
With AppWD.activedocument
.Content.InsertAfter Txtstr
End With
'close and save new or existing doc
AppWD.activedocument.SaveAs ("C:\test\test.doc")
'close and save existing doc
' AppWD.ActiveDocument.Close savechanges:=True
'clean up
Set wrdDoc = Nothing
AppWD.Quit
Set AppWD = Nothing
MsgBox "Finished"
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "error"
Set wrdDoc = Nothing
AppWD.Quit
Set AppWD = Nothing
End Sub

psctornado
03-23-2013, 06:41 PM
With your help Dave I was able to get this to work with my workbook. I have 2 questions still for this issue.

1) Is there anyway to make the document not save after the macro is applied? That is to say currently it just updates the referenced doc. I would like that when the macro is run the doc is maximized on the screen.

2) Is there a way to not have a blank document saved? Meaning that currently it has the doc referenced, how would I get it so that it doesn't need a blank doc in general?

Thanks again for all the help...sorry if I'm being an annoyance.
:thumb


I usually don't look at files but it's a boring Saturday afternoon. You need to set up your XL sheet so that data for each column is only in 1 column (ie. You have $ 120.00 taking up 3 columns instead of 1.. just right click the cell/range and hit format cells). Anyways, this might provide a better starting point for you. This code refers to a "test" folder on the "C" drive...adjsut to suit. You can insert this in sheet code and then call the macro. Good luck. Dave
Sub XLWordTable2()
Dim AppWD As Object, wrdDoc As Object
Dim Rowtot As Integer, Coltot As Integer, Cnt As Integer
'adds text & table to Word doc from XL
'no Word reference required
On Error GoTo ErFix
Set AppWD = CreateObject("Word.Application")
'open existing word doc file ie. "C:\test\test.doc"
'Set wrdDoc = AppWD.Documents.Open(Filename:="C:\test\test.doc")
'open new doc
Set wrdDoc = AppWD.Documents.Add
'AppWD.Visible = True
'clear doc
' With wrdDoc
' .Range(0, .Characters.Count).Delete
'End With
AppWD.activedocument.Select
With AppWD.Selection
.Font.Size = 11
.Font.Bold = True
.Font.Name = "Times New Roman"
.typetext Text:=CStr(Sheets("lit").Range("AB" & 1))
.typeparagraph
.typetext Text:=CStr(Sheets("lit").Range("AB" & 2))
.typeparagraph
.typetext Text:=CStr(Sheets("lit").Range("AB" & 3))
.typeparagraph
.typetext Text:=CStr(Sheets("lit").Range("AB" & 4))
.typeparagraph
End With
'add table
Coltot = 4
With Sheets("lit")
lastrow = .Range("c" & .Rows.Count).End(xlUp).Row
End With
Rowtot = lastrow - 18
With wrdDoc
.Tables.Add AppWD.Selection.Range, numrows:=Rowtot, Numcolumns:=Coltot
.Tables(1).cell(1, 1).Range = CStr(Sheets("lit").Range("c" & 19))
.Tables(1).cell(1, 2).Range = CStr(Sheets("lit").Range("m" & 19))
.Tables(1).cell(1, 3).Range = CStr(Sheets("lit").Range("t" & 19))
.Tables(1).cell(1, 4).Range = CStr(Sheets("lit").Range("aa" & 19))
For Cnt = 2 To Rowtot
.Tables(1).cell(Cnt, 1).Range = CStr(Sheets("lit").Range("c" & 18 + Cnt))
.Tables(1).cell(Cnt, 2).Range = CStr(Sheets("lit").Range("o" & 18 + Cnt))
.Tables(1).cell(Cnt, 3).Range = CStr(Sheets("lit").Range("v" & 18 + Cnt))
.Tables(1).cell(Cnt, 4).Range = CStr(Sheets("lit").Range("ab" & 18 + Cnt))
Next Cnt
End With
'autoformat table
'table autoformat #'s 0 to 42 'ie. exchange 13 for 0 to 42
AppWD.activedocument.Tables(1).AutoFormat Format:=13, _
ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
'autofit table cell contents
With AppWD.activedocument.Tables(1)
.Columns.AutoFit
End With
'make text string with space following table
Dim Txtstr As String
Txtstr = vbCrLf & "Test finished at: " & Now()
'add text string after table
With AppWD.activedocument
.Content.InsertAfter Txtstr
End With
'close and save new or existing doc
AppWD.activedocument.SaveAs ("C:\test\test.doc")
'close and save existing doc
' AppWD.ActiveDocument.Close savechanges:=True
'clean up
Set wrdDoc = Nothing
AppWD.Quit
Set AppWD = Nothing
MsgBox "Finished"
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "error"
Set wrdDoc = Nothing
AppWD.Quit
Set AppWD = Nothing
End Sub

Dave
03-24-2013, 04:48 AM
No annoyance but i did include code in the above to address different needs, anyways....
#1) Remove the saveas line of code and this should workAppWD.ActiveDocument.Close savechanges:=False

Remove the comment apostrophe at the start of this line of code to see the doc... 'AppWD.Visible = True

#2 Do you want to open an existing document? If you do, you will also probably need to clear it as well. Again sample code is included in the above to trial all of this. Just comment out the add document and remove the comments from the start of the open doc and clear doc parts of the code. HTH. Dave

psctornado
03-24-2013, 07:18 AM
Hey Dave,

I've got the code working for the most part with the workbook I'm currently using. The only issue I'm coming across is that my table is including the text that is below the table. Could you explain at all the code below since I'm thinking that is the issue with it including that text. If it helps at all, the max amount rows will be 4, plus the header row, so in total a max of 5 (if you include the header row). My thought was that I would have a count in excel with how many rows are in the given table and then have it reference the specific code for that table row count. In near most all instances there will be a table.

Thanks again for all the help.
:thumb

Rowtot = lastrow - 18 With wrdDoc .Tables.Add AppWD.Selection.Range, numrows:=Rowtot, Numcolumns:=Coltot .Tables(1).cell(1, 1).Range = CStr(Sheets("lit").Range("c" & 19)) .Tables(1).cell(1, 2).Range = CStr(Sheets("lit").Range("m" & 19)) .Tables(1).cell(1, 3).Range = CStr(Sheets("lit").Range("t" & 19)) .Tables(1).cell(1, 4).Range = CStr(Sheets("lit").Range("aa" & 19)) For Cnt = 2 To Rowtot .Tables(1).cell(Cnt, 1).Range = CStr(Sheets("lit").Range("c" & 18 + Cnt)) .Tables(1).cell(Cnt, 2).Range = CStr(Sheets("lit").Range("o" & 18 + Cnt)) .Tables(1).cell(Cnt, 3).Range = CStr(Sheets("lit").Range("v" & 18 + Cnt)) .Tables(1).cell(Cnt, 4).Range = CStr(Sheets("lit").Range("ab" & 18 + Cnt)) Next Cnt

Dave
03-24-2013, 12:50 PM
This code determined the number of rows by looking at the last row of "C"..


With Sheets("lit")
lastrow =
.Range("c" & .Rows.Count).End(xlUp).Row
End With

Rowtot = lastrow - 18

Just get rid of the lastrow part and set your number of rows...
Rowtot = 5
Good luck. Dave

psctornado
03-24-2013, 02:03 PM
Hi Dave,

The edit of rows helped a bit, but its still pulling in the text that is below the table code into the table itself.

Basically the code that i have is this :

Coltot = 4
With Sheets("lit")
Rowtot = 5
End With
With wrdDoc
.Tables.Add AppWD.Selection.Range, numrows:=Rowtot, Numcolumns:=Coltot
.Tables(1).Cell(1, 1).Range = CStr(Sheets("lit").Range("BG" & 32))
.Tables(1).Cell(1, 2).Range = CStr(Sheets("lit").Range("BI" & 32))
.Tables(1).Cell(1, 3).Range = CStr(Sheets("lit").Range("BK" & 32))
.Tables(1).Cell(1, 4).Range = CStr(Sheets("lit").Range("BM" & 32))
End With
'autoformat table
'table autoformat #'s 0 to 42 'ie. exchange 13 for 0 to 42
AppWD.ActiveDocument.Tables(1).AutoFormat Format:=1, _
ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
'autofit table cell contents
With AppWD.ActiveDocument.Tables(1)
.Columns.AutoFit
End With

With AppWD.Selection
.TypeParagraph
.TypeParagraph
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("A" & 46))
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("A" & 47))
.TypeParagraph
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("A" & 54))
.TypeParagraph
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("A" & 57))
.TypeParagraph
.TypeParagraph
.TypeParagraph
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("A" & 60))
End With

AppWD.ActiveDocument.Shapes.AddPicture "I:\" & Sheet11.Range("B3") & ".jpg", False, True, 0, 0

End Sub

As you can see I pulled out the code :
For Cnt = 2 To Rowtot .Tables(1).cell(Cnt, 1).Range = CStr(Sheets("lit").Range("c" & 18 + Cnt)) .Tables(1).cell(Cnt, 2).Range = CStr(Sheets("lit").Range("o" & 18 + Cnt)) .Tables(1).cell(Cnt, 3).Range = CStr(Sheets("lit").Range("v" & 18 + Cnt)) .Tables(1).cell(Cnt, 4).Range = CStr(Sheets("lit").Range("ab" & 18 + Cnt)) Next Cnt
so I'm not sure if that is causing the issue. The code in the AppWd section is pulling into the table in addition to what is getting called out in cells BG through BK. Any thoughts of what I'm missing here????
:help

This code determined the number of rows by looking at the last row of "C"..


With Sheets("lit")
lastrow =
.Range("c" & .Rows.Count).End(xlUp).Row
End With

Rowtot = lastrow - 18
Just get rid of the lastrow part and set your number of rows...
Rowtot = 5 Good luck. Dave

Dave
03-24-2013, 10:24 PM
The code I posted originally was tested before posting using "C" as the column to indicate the last row of data. If you now have something below the last row of "C" data don't use "C" to look for the last row... change it to "A" or whatever doesn't have anything below it. The code you took out fills the table with your data... it is nb. Your code posted seems to suggest that you have changed your requirements? You should consider starting again and setting up a data output sheet that is more easily accessed and manipulated. It really is impossible for me to guess what the problem is... I deleted the file after I provided you a solution. I have a notion that this line of code from my original post might be needed (with adjustment). Dave

Dim Txtstr As String
Txtstr = vbCrLf & "Test finished at: " & Now()
'add text string after table
With AppWD.activedocument
.Content.InsertAfter Txtstr
End With

snb
03-25-2013, 03:34 AM
The simplest way to import a Range of an Excel file into a Word file:
In this case range("A1:F12")

Sub M_snb()
With CreateObject("Word.document")
.Fields.Add .Paragraphs(1).Range, -1, "INCLUDETEXT " & Replace(ThisWorkbook.FullName, "\", "\") & " A1:F12"
.Fields.Update
End With
End Sub

psctornado
03-25-2013, 05:33 AM
Hi Dave / SNB,

My entire code is as follows :

Private Sub cmdTrigLit_Click()
Dim Rowtot As Integer, Coltot As Integer, Cnt As Integer
Dim AppWD As Object, wrdDoc As Object

Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True

' Tell Word to create a new document
Set wrdDoc = AppWD.Documents.Add
AppWD.ActiveDocument.Select

' Document entered
With AppWD.Selection
.Font.Size = 11
.Font.Name = "Times New Roman"
.PageSetup.TopMargin = InchesToPoints(1)
.PageSetup.LeftMargin = InchesToPoints(1)
.PageSetup.RightMargin = InchesToPoints(1)
.ParagraphFormat.RightIndent = InchesToPoints(0)
.ParagraphFormat.LeftIndent = InchesToPoints(0)
.ParagraphFormat.SpaceBeforeAuto = False
.ParagraphFormat.SpaceAfterAuto = False
End With

With AppWD.Selection
.ParagraphFormat.Alignment = wdAlignParagraphRight
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 1))
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 2))
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 3))
.TypeParagraph
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 4))
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 5))
.TypeParagraph
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 6))
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 7))
.TypeParagraph
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 8))
.ParagraphFormat.TabStops.Add Position:=InchesToPoints(6.25), _
Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
.TypeText Text:=vbTab & Sheet14.Range("V9")
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 9))
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("AB" & 10))
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("A" & 12))
.TypeParagraph
.Font.Bold = False
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("A" & 14))
.TypeParagraph
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("A" & 16))
.TypeParagraph
.TypeParagraph
.TypeText Text:=" - " & Sheets("lit").Range("D" & 19)
.TypeParagraph
End With

Dim let_type As Integer

If Sheet1.Range("J32") = 0 Then
let_type = 0
ElseIf Sheet1.Range("J30") > Sheet1.Range("J31") Then
let_type = 1
End If

If (Sheet11.Range("B10") <> "") Then
With AppWD.Selection
.TypeText Text:=" - " & Sheets("lit").Range("B" & 10)
.TypeParagraph
End With
End If

With AppWD.Selection
.TypeParagraph
.ParagraphFormat.TabStops.Add Position:=InchesToPoints(2.25), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
.TypeText Text:=vbTab
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("J" & 23))
.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4.5), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
.TypeText Text:=vbTab & CStr(Sheets("lit").Range("S" & 23))
.TypeParagraph
.TypeText Text:=vbTab & vbTab & CStr(Sheets("lit").Range("S" & 24))
.TypeParagraph
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("B" & 26)) & vbTab
.ParagraphFormat.TabStops.Add Position:=InchesToPoints(2.88), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
.ParagraphFormat.TabStops.Add Position:=InchesToPoints(5.13), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
.Font.Bold = True
.TypeText Text:=vbTab & CStr(Sheets("lit").Range("J" & 26)) & vbTab
.TypeText Text:=vbTab & CStr(Sheets("lit").Range("S" & 26))
.TypeParagraph
.TypeParagraph
.Font.Bold = False
End With

If (let_type = 1) Then

With AppWD.Selection
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("A" & 28))
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("A" & 29))
.TypeParagraph
.TypeParagraph
End With
Coltot = 4
With Sheets("lit")
Rowtot = 3
End With
With wrdDoc
.Tables.Add AppWD.Selection.Range, numrows:=Rowtot, Numcolumns:=Coltot
.Tables(1).Cell(1, 1).Range = CStr(Sheets("lit").Range("A" & 33))
.Tables(1).Cell(1, 2).Range = CStr(Sheets("lit").Range("B" & 33))
.Tables(1).Cell(1, 3).Range = CStr(Sheets("lit").Range("C" & 33))
.Tables(1).Cell(1, 4).Range = CStr(Sheets("lit").Range("D" & 33))
.Tables(1).Cell(2, 1).Range = CStr(Sheets("lit").Range("A" & 34))
.Tables(1).Cell(2, 2).Range = CStr(Sheets("lit").Range("B" & 34))
.Tables(1).Cell(2, 3).Range = CStr(Sheets("lit").Range("C" & 34))
.Tables(1).Cell(2, 4).Range = CStr(Sheets("lit").Range("D" & 34))
.Tables(1).Cell(3, 1).Range = CStr(Sheets("lit").Range("A" & 35))
.Tables(1).Cell(3, 2).Range = CStr(Sheets("lit").Range("B" & 35))
.Tables(1).Cell(3, 3).Range = CStr(Sheets("lit").Range("C" & 35))
.Tables(1).Cell(3, 4).Range = CStr(Sheets("lit").Range("D" & 35))
End With
'autoformat table
'table autoformat #'s 0 to 42 'ie. exchange 13 for 0 to 42
AppWD.ActiveDocument.Tables(1).AutoFormat Format:=1, _
ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
'autofit table cell contents
With AppWD.ActiveDocument.Tables(1)
.Columns.AutoFit
End With
End If

With AppWD.Selection
.TypeParagraph
.TypeParagraph
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("A" & 38))
.TypeParagraph
.Font.Bold = False
.TypeText Text:=CStr(Sheets("lit").Range("A" & 39))
.TypeParagraph
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("A" & 46))
.TypeParagraph
.TypeParagraph
.TypeText Text:=CStr(Sheets("lit").Range("A" & 49))
.TypeParagraph
.TypeParagraph
.TypeParagraph
.Font.Bold = True
.TypeText Text:=CStr(Sheets("lit").Range("A" & 51))
End With

AppWD.ActiveDocument.Shapes.AddPicture "I:\" & Sheet11.Range("B3") & ".jpg", False, True, 0, 0

End Sub

The main issue I'm having is that the area below the table coding is pulling into the table itself. What I'm looking to accomplish is to have the values named in the table coding to create its own table, then have text below it. I haven't even gotten to how I need to format as it relates to certain cells being shaded & bold, but I'm hoping that if I can get the table created with the values that are exclusively in rows 33 - 35 I should be able to replicate it depending on whatever rows are needed depending on the situation.

Does that make sense? :help

snb
03-25-2013, 06:36 AM
Please reread my suggestion (and test it !).

But to be honest: why don't you make a Word Document, containing text and a table ? You can do calculations in a Word Table. The use of Excel in this case is redundant and unnecessarily complicating things.

psctornado
03-25-2013, 06:47 AM
Hi SNB,

I guess the main reason for doing it this way is access. If say I didn't have access to the word doc to do the standard word merge this gives me the ability to create literature globally. The word docs are typically stored on network drives and some folks do not have access to them all the time.

How would I apply your vba to the vba I pasted above?

Thanks!:thumb


Please reread my suggestion (and test it !).

But to be honest: why don't you make a Word Document, containing text and a table ? You can do calculations in a Word Table. The use of Excel in this case is redundant and unnecessarily complicating things.

snb
03-25-2013, 08:08 AM
I don't see why you wouldn't be able to access a Word document.

If you want to make a string of range(AB1:AB11") you better use a oneliner:
msgbox join(application.transpose(sheets("lev").Range("AB1:AB11")),vbcr & vbcr)

The use of Cstr is redundant: "xxx" & 5 gives the same result as "xxx" & cstr(5)

It's meant to be the replacement.

psctornado
03-25-2013, 08:18 AM
Ok say for instance your creating a document via an excel spreadsheet locally (not connected to a work network). One could not create the lit due to the fact the template is not accessible.

This is the reasoning behind my need to create the word doc through excel. I think we're close here, just the text from the cells below the table are getting dragged in & they shouldn't be.

I'm confused as to why & what I can do to remedy this situation. Any thoughts Dave or SNB or anyone else for that matter??? Sorry to be persistent on this, but there has to be some reason as to why the table is pulling in additional lines.

Any help would be great! :dunno


I don't see why you wouldn't be able to access a Word document.

It's meant to be the replacement.

Dave
03-25-2013, 09:42 AM
Trial this code after the table code then continue with your code. Dave

With AppWD.activedocument
.Content.InsertAfter CStr(Sheets("lit").Range("A" & 38))
End With

snb
03-25-2013, 10:10 AM
In Word you don't need template. Any wordfile will do:

To create a copy of a Wordfile:


Documents.Add "G:\OF\example.docx"

psctornado
03-25-2013, 10:25 AM
Hi Dave,

The code you said to apply seems to have worked for the most part. To apply formatting would I need to use the Autoformat? is there a way to Bold say the header row, and say the bottom row, but the middle rows have no font?

I'm also running into an issue applying bold to on certain lines of the content. Say I want to bold A38, but not A39, but then again on A51. Any thoughts of how to do that?

Thanks again for the help!

psctornado
03-25-2013, 10:27 AM
Hi SNB,

When creating a wordfile through excel VBA wouldn't I need to still setup the mail merge word fields within the word doc? Do you have an example of how my above coding could work with the wordfile suggestion?

:dunno


In Word you don't need template. Any wordfile will do:

To create a copy of a Wordfile:


Documents.Add "G:\OF\example.docx"

snb
03-25-2013, 02:46 PM
see the attachment.
put both files in the same folder.
Open the word document.
If you change anything in the Excel document, you can refresh the Word document using F9.

psctornado
03-25-2013, 03:45 PM
Hey SNB,

This looks pretty slick & easy as well. A couple questions on this though.

1) Does the user have to save the xls in order for the merge to occur?
2) How would I trigger to create lit then from XLS for this to automatically be created?
3) Are there any limitations to using this method?

Thanks!
:thumb

see the attachment.
put both files in the same folder.
Open the word document.
If you change anything in the Excel document, you can refresh the Word document using F9.

snb
03-25-2013, 04:26 PM
ad 1. no
ad 2. I do not understand this question (What is 'create lit')
ad 3. I didn't encounter any up to now (since 2000)

psctornado
03-25-2013, 04:33 PM
Sorry I should have expanded a bit on #2. So say a person wants to utilize this method. What kind of macro would have to be created to 'automate' the producing of the letter? Does this require a blank document to exist in order for it to work, meaning does a word doc have to be saved previously in order to have the 2 communicate between each other?

Is it possible to have the formatting that is in XL reflect the same in word?

Sorry for all the loaded questions, I just haven't seen this before & appreciate the help that both you & Dave have provided on my issue.


ad 1. no
ad 2. I do not understand this question (What is 'create lit')
ad 3. I didn't encounter any up to now (since 2000)

snb
03-26-2013, 01:46 AM
If you want to 'produce' the document the only thing you have to do is open it.
In Word:
Documents.open "G:\OF\tom.docx"

But it would be wiser to open the document as a copy:
Documents.add "G:\OF\tom.docx"

From Excel you can simply use:
with Getobject("G:\OF\tom.docx")
.saveas "G:\OF\tom_001.docx"
- - - - - - -
end with

With this method only the values from Excel will be transferred, not the formatting.
You can format the resulting table in Word if you want to.

If you want to import the Exceltable, formatting included, you need to use another method.

psctornado
03-26-2013, 03:40 AM
Hey SNB,

Thanks for the great tips! You mentioned to import the table with formatting including would require another method, how would I go about doing that?

That's what I would really like to achieve in this whole exercise.

Thanks again

snb
03-26-2013, 03:43 AM
Please do not quote !

See the attachment

psctornado
03-26-2013, 03:49 AM
Ok quotes removed from my last past...

snb
03-26-2013, 04:00 AM
OK. Thanks !

See my amended last post.

psctornado
03-27-2013, 03:50 AM
Hi SNB,

I've been working with your sample and things seem decent for the most part with my existing spreadsheet. I do have a question though. If say I went the standard mail merge method & created a table already formatted for size & color, is possible to copy/paste the cell contents all together? Meaning...that if say I have 4 rows, 4 columns that I could put all the contents in there with one single action as you did with 'INCLUDETEXT' command? I know previously, the template had an individual mail merge field for each cell and I didn't know if there was a possibility to do it all in one merge field.

Thanks again!

snb
03-27-2013, 05:33 AM
From Word:


Sub tst()
With GetObject("G:\OF\adressen.xls")
sn = .sheets(1).Range("A1:D4").Value
.Close False
End With

For j = 1 To UBound(sn)
For jj = 1 To UBound(sn, 2)
ActiveDocument.Tables(1).Cell(j, jj).Range.Text = sn(j, jj) & Tables(1).Cell(j, jj).Range.Text
Next
Next
End Sub

psctornado
03-27-2013, 06:26 AM
Hi SNB,

The code above seems to be giving me a debugging error. Can I do this with multiple tables existing in a single document? I hate asking you for another sample since your help has been excellent, but could I bother you for another one? Do we also need to name each table for this to work? How would I replicate this for multiple tables if such exist in my word doc? As I mentioned before I have a count in place, in which there could be 3,4, or 5 rows in a given table depending on the pay periods involved where money is due.

snb
03-27-2013, 06:52 AM
As long as you do not specify any error there's nothing we can do....
The code assumes the presence of at least 1 table (4 columns/4 rows) in the Word document.
You will have to adapt the Excel filename too.


Sub tst()
With GetObject("G:\OF\adressen.xls")
sn = .sheets(1).Range("A1:D4").Value
.Close False
End With

For j = 1 To UBound(sn)
For jj = 1 To UBound(sn, 2)
ActiveDocument.Tables(1).Cell(j, jj).Range.Text = sn(j, jj) & activedocument.Tables(1).Cell(j, jj).Range.Text
Next
Next
End Sub

psctornado
03-27-2013, 07:15 AM
Ok I figured it out, had one too many spaces in the xls file reference. So if I had multiple tables in my document, but say table 1 = excel range (A1:D4), and my 2nd table referenced cells (A10:D12). Would all I need to do is update the range and copy the code above a 2nd time?

Is there anyway to modify the above code so that it doesn't require 4 columns & 4 rows? Could I have just 1 table and then based off if there is 3 rows, 2, or 5, that it could delete the excess rows below?

Again thank you for all the help!