VBA excel nesting data from excel into a table in word (copying excel data into Word table) - vba

I'm trying to paste a table into word from excel with VBA Excel.
I'm pasting it into a cell in a single column table of 4 rows I created in Word. So it is essentially a nested table.
I keep getting,
Run-time error 4605: Method 'PasteAsNestedTable' of object Selection failed
I'm trying to use PastAsNestedTable because otherwise I get the Run-time error about cells not matching as it is trying to merge the two tables.
So I get it is saying PasteAsNestedTable isn't a method of selection but how do I get around this issue?
My updated code goes:
Dim wdApp As Word.Application
Dim wdDoc as Word.Document
Dim tabl1 as Table, tabl2 as Table
Set wdApp = new Word.Application
With wdApp
.visible = True
.Activate
.Document.Add(location)
Set wdDoc=wdApp.ActiveDocument
With wdApp
Charts("chart1").ChartArea.Copy
.Selection.GoTo what:=-1,Name:="chart1"
.selection.Paste
(Then add some more charts)
End With
Sheets("Sheet1").Range("A1:F10").Copy
Set wdDoc=wdApp.ActiveDocument
wdDoc.Bookmarks("table").Range.PasteAsNestedTable
With wdApp
(Then repeat above pasting charts + tables)
`
If I made the Range a ListObjects could I somehow copy it in that way?

Don't use Selection.
This here works for me (Word with correct document already opened):
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = GetObject(, "Word.Application")
Sheets(1).Range("A1:F10").Copy
Set wdDoc = wdApp.ActiveDocument
wdDoc.Bookmarks("tableplace").Range.PasteAsNestedTable
You can of course replace GetObject(, "Word.Application") with your new Word.Application and set wdDoc as wdApp.Documents.Open(pathtoyourdoc).
Then combine with my answer from your other thread, replace wdthere with wdDoc and you should be good to go.
Edit I have changed my code to reflect your current variables and bookmark names:
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim tabl1 As Table, tabl2 As Table
Set wdApp = New Word.Application
With wdApp
.Visible = True
.Activate
Set wdDoc = .Documents.Open(Location)
End With
Charts("chart1").ChartArea.Copy
wdDoc.Bookmarks("chart1").Range.Paste
Sheets("Sheet1").Range("A1:F10").Copy
wdDoc.Bookmarks("table").Range.PasteAsNestedTable
'(Continue like this for other charts + tables)
Note:
Do not use Douments.Add, as this will add a new empty document based on a template. This will not have your bookmarks. Use .Open instead.
Close With blocks properly
Do not set the same object over and over again. Set it once and work with that object
Do not use Selection unless absolutely necessary. Not necessary in this case.

You can set DocVariables in Word. Google this if you don't know how to do this. Then, run the script below, from Excel.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
'On Error Resume Next
objWord.ActiveDocument.variables("FirstName").Value = Range("FirstName").Value
objWord.ActiveDocument.variables("LastName").Value = Range("LastName").Value
objWord.ActiveDocument.variables("Another").Value = Range("Another").Value
objWord.ActiveDocument.Fields.Update
'On Error Resume Next
objWord.Visible = True
End Sub

Related

how to use an already open document from another module?

i write in a word.document. When it is necessary i write a paragraph in another document and when i finish this document is closed. then i try to copy this paragraph to the first document which remains open.
I try some things but in vain.
when i do this:
Dim wdDocMain As Word.Document
Set wdDocMain = ActiveDocument
i receive the message run time error 4248 This command is not available because no document is open.
when i do this
Dim wdDocMain As Word.Document
Set wdDocMain = wdApp.Documents.Open(FileName:=pathmaindoc,_ ReadOnly:=False, Visible:=True)
wdDocMain.Activate
i receive the message run time error 91 object variable or with block variable not set.
i find a solution.
To close the open document and then to reopen it like this:
Set wdDocMain = wdApp.Documents.Open(FileName:=pathmaindoc,_ ReadOnly:=False, Visible:=True)
but of cource it isnt the best.
Edit.
I would like to thank you in advance for your comments.
i share more lines from my code as Timothy Rylatt suggested.
In my main sub:
Dim wdapp As Word.Application
Dim wdDoc As Word.Document
Set wdapp = New Word.Application
Set wdDoc = wdapp.Documents.Open(FileName:=PathName_HiveDown_Creation,_ ReadOnly:=False, Visible:=True)
wdapp.Visible = True
when a condition is met then i call a module (copyparafromtemplatetomain):
pathmaindoc = PathName_HiveDown_Creation
pathtemplatedoc = PathName_Template
'wdDoc.Close savechanges:=True
copyparafromtemplatetomain
Public wdapp As Word.Application
Public wdDocMain As Word.Document
Sub copyparafromtemplatetomain(pathmaindoc As Variant, pathtemplatedoc As Variant, paramain As Variant, paratemplate As Variant, index As Integer)
Dim wdDocTemplate As Word.Document
Dim PathName_MainDoc As Variant
PathName_MainDoc = pathmaindoc
Set wdDocMain = wdapp.ActiveDocument
here, i receive run time error 91.
the only way to run is when i close the doc. in the first sub

VBA copying from Excel file to WORD file bookmark

When I copy a chart from Excel ('Report' sheet) to a WORD file ('Report template.docx'), why does VBA wipe out the previous content of the WORD file? I suspect the problem is in line 'wddoc.Range.Paste' but I don't know how to change it to avoid the problem.
Sub ActivateWordTransferData()
Dim wdapp As Object, wddoc As Object
Dim strdocname As String
Set wdapp = GetObject(, "Word.Application")
wdapp.Visible = True
strdocname = "C:\users\ian\Documents\Dropbox\Report template.docx"
Set wddoc = wdapp.documents(strdocname)
Worksheets("Report").Shapes("Chart 2").Copy
wdapp.Activate
wddoc.bookmarks("bkmark4").Select
wddoc.Range.Paste
wddoc.Save
Set wddoc = Nothing
Set wdapp = Nothing
Application.CutCopyMode = False
End Sub
I'm not sure why the contents of the Word document are being overwritten.
However, removing the .Select operation and just pasting into the bookmark's range seems to work.
Remove these lines:
wddoc.bookmarks("bkmark4").Select
wddoc.Range.Paste
and replace with this line:
wddoc.bookmarks("bkmark4").Range.Paste

Excel VBA copy pasting each named range to word

I have dynamic named range of cell. I need to paste each named range in one page of word and move to next page for next named range. I tried copule of code, I am unable to do.Each named range data is overlapping each other. Can anyone help me, please.
Set wbBook = ActiveWorkbook
Set rs = wbBook.Names(1).RefersToRange
For i = 2 To wbBook.Names.Count
Set rs = Union(rs, wbBook.Names(i).RefersToRange)
Next
rs.Copy
With wd.Range
.Collapse Direction:=0
.InsertParagraphAfter
.Collapse Direction:=0
.PasteSpecial False, False, True
Application.CutCopyMode = False
End With
It sounds like you want to copy each range onto different pages so I'm not sure why you're using a union. Here is a quick example of copying each named range 'name' onto a new sheet in a word document. Note: I created a new doc for simplicity.
Edit - I added copy/paste functionality of data to the end. Formatting and such depends on what you have or want.
Sub main()
'Create new word document
Dim objWord As Object
Dim objDoc As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.documents.Add()
Dim intCounter As Integer
Dim rtarget As Word.Range
Dim wbBook As Workbook
Set wbBook = ActiveWorkbook
'Loop Through names
For intCounter = 1 To wbBook.Names.Count
Debug.Print wbBook.Names(intCounter)
With objDoc
Set rtarget = .Range(.Content.End - 1, .Content.End - 1)
'Insert page break if not first page
If intCounter > 1 Then rtarget.insertbreak Type:=wdPageBreak
'Write name to new page of word document
rtarget.Text = wbBook.Names(intCounter).Name & vbCr
'Copy data from named range
Range(wbBook.Names(intCounter)).Copy
Set rtarget = .Range(.Content.End - 1, .Content.End - 1)
rtarget.Paste
End With
Next intCounter
End Sub
Excel
Resulting Word Document
I don't think this is the best solution out there (as I don't normally play with Word VBA) but I have tried this and it does seems to work:
Sub AddNamedRangesToWordDoc()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim intCount As Integer
Dim oRng As Range
Dim oSelection As Object
Set oWord = New Word.Application
Set oDoc = oWord.Documents.Add
oWord.Visible = True
For intCount = 1 To ActiveWorkbook.Names.Count
Set oRng = Range(ActiveWorkbook.Names(intCount).RefersToRange.Name.Name)
oRng.Copy
oDoc.ActiveWindow.Selection.PasteSpecial , , 0
Set oSelection = oWord.Selection
oSelection.InsertBreak (wdPageBreak)
Next
Set oSelection = Nothing
Set oRng = Nothing
Set oDoc = Nothing
Set oWord = Nothing
End Sub
NOTE: I am creating a new word application. You might have to check if word is already open and how you want to deal with an existing word doc. Also, I'm not creating the word object. I have Microsoft Word xx.x Object Library referenced in the project as I prefer to work with built in libraries. Also, function presumes that you only have 1 worksheet and all your ranges are in that worksheet

How to make sure from Excel that a specific Word document is open or not?

I wanted my excel macro to create a report by inserting spreadsheet data after Bookmarks I placed in the template word documents.
But I found out that if the template word document is already open, the macro will crash, and consequently the template document will be locked as Read-only and no longer accessible by the macro.
Is there a way to prevent then macro from crashing even if the template word document is already open?
Below is my code
Set wdApp = CreateObject("Word.Application") 'Create an instance of word
Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Templates\Template_Confirmation.docx") 'Create a new confirmation note
Here comes an evolution of what was suggested in comments :
A function that test if the file is open and offer you to set it directly while testing.
How to use it :
Sub test()
Dim WdDoc As Word.Document
Set WdDoc = Is_Doc_Open("test.docx", "D:\Test\")
MsgBox WdDoc.Content
WdDoc.Close
Set WdDoc = Nothing
End Sub
And the function :
Public Function Is_Doc_Open(FileToOpen As String, FolderPath As String) As Word.Document
'Will open the doc if it isn't already open and set an object to that doc
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
On Error Resume Next
'Set wrdApp = GetObject(, "Word.Application")
If wrdApp Is Nothing Then
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(FolderPath & FileToOpen)
Else
On Error GoTo NotOpen
Set wrdDoc = wrdApp.Documents(FileToOpen)
GoTo OpenAlready
NotOpen:
Set wrdDoc = wrdApp.Documents.Open(FolderPath & FileToOpen)
End If
OpenAlready:
On Error GoTo 0
Set Is_Doc_Open = wrdDoc
Set wrdApp = Nothing
Set wrdDoc = Nothing
End Function
Only downside of this, you don't have the reference of the Word application...
Any suggestion/evolution are welcome!

Delete row when fields are empty

I am trying to use Visual Basic so that I can populate word templates with data from excel. I have a macro that fills in fields in a Word document table from a table in Microsoft Excel. So far, if the excel table is smaller than the word table, the message "Error! No document variable supplied" prints in the word table and I delete that field using the macro (below). BUT, I also want to delete the entire rows in the Word table where this error occurs. Can you help me figure out how to do this?
Sub Rectangle_Click()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim ws As Worksheet
Dim oHeader As Word.HeaderFooter
Dim oSection As Word.Section
Dim oFld As Word.Field
Dim flds As Word.Fields
Dim fld As Word.Field
Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Activate
On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
If wrdApp Is Nothing Then Set wrdApp = CreateObject("Word.Application")
On Error GoTo 0
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add(Template:="C:\Documents\mytemplate.dotm")
With wrdDoc
.Variables("foo1").Value = Range("A5").Value
.Variables("foo2").Value = Range("A6").Value
.Variables("foo3").Value = Range("A7").Value
.Variables("bar1").Value = Range("B5").Value
.Variables("bar2").Value = Range("B6").Value
.Variables("bar3").Value = Range("B7").Value
.Range.Fields.Update
End With
wrdDoc.Range.Fields.Update
Set flds = ActiveDocument.Fields
For Each fld In flds
If fld.Type = wdFieldDocVariable Then
If fld.Result = "Error! No document variable supplied." Then
Debug.Print fld.Code
'ALSO DELETE THE ROW WHERE THIS EMPTY FIELD WAS FOUND!!'
fld.Delete
End If
End If
Next
Set wrdDoc = Nothing
Set wrdApp = Nothing
Application.CutCopyMode = False
End Sub
How can I get rid of rows (or cells) where "no document variable supplied" occurs?
If you want to delete the whole row of table where your current selection is then use:
Word.Selection.Rows.Delete