Pasting a table into open Word document at a bookmark - vba

I have searched a fair bit on this and other forums but I can't get code to work. I know this is user error - I am learning/self-taught at this.
What I want is to copy a (admittedly large) table in a specific Excel worksheet into an already-open Word document, at a specific point. I have seen this done using a keyword search but I would prefer to use a bookmark (and I've made the bookmark thing work!) purely because it's not visible to the end user. I'm trying to automate the creation of a document as much as possible.
The below code works, but I can only get it to work when the Word document in question is closed. If I try to run this sub when the word doc is open, it just tries to re-open it and of course can't. I can't find a neat bit of code that allows me to paste data into an already-open document.
Also, I can make this work for one value, but not for a range (i.e. the table I want to paste).
Sub ExcelRangeToWord()
Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Summary")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'open the word doc
objWord.Documents.Open "K:\Exeter Office\Quotebuilder project\testbed\test.docx" 'change as required
'pastes the value of cell I19 at the "heatlosses" bookmark
With objWord.ActiveDocument
.Bookmarks("heatlosses").Range.Text = ws.Range("I19").Value
End With
'Optimize Code
Set objWord = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
I'm trying to tackle this one step at a time, cos then I have half a chance of understanding things a bit better...
If I try and copy/paste a range, instead of just one value, I was using Currentregion to select all used cells surrounding B19:
With objWord.ActiveDocument
.Bookmarks("heatlosses").Range.Text = Range("B19").CurrentRegion
End With
All this does is paste the word "True" into Word.
I am baffled. Please, can anyone offer assistance?

Use the code below to achieve what you require:
Sub CopyToWord()
Dim wApp, wDoc
'Get the running word application
Set wApp = GetObject(, "Word.Application")
'select the open document you want to paste into
Set wDoc = wApp.documents("test.docx")
'copy what you want to paste from excel
Sheet1.Range("A1").copy
'select the word range you want to paste into
wDoc.bookmarks("heatlosses").Select
'and paste the clipboard contents
wApp.Selection.Paste
End Sub

Related

Only copy cells with data from Excel to Word

I need some further help developing my code. I have the basics down now with some earlier help but I am not sure on this next part.
The code I am designing will run in a spreadsheet whereby the amount of rows used in a sheet will vary depending on the amount of data being used. (Due to nature of business and Norwegian Laws, I can't go into more details.)
I'd like to have a Range of B5:B1000 as a standard range and only have cells containing data be auto filled into the template but I am unsure how to write said code. Could someone please advise how I am able to go about this?
All questions related to this have been based on copying from one sheet to another.
This is my code so far which I am using in excel:
Sub CopyRangeToWord()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("C:\Users\CoffeeFuelsMeNow\Documents\Custom Office Templates\EVERYTHING IS AWESOME.dotx")
Range("B5:B92").Copy
With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range
'All formatting goes here
.PasteAndFormat (wdFormatPlainText)
End With
objWord.Visible = True
End Sub
This assumes that column B is compact (no holes in the data):
Sub CopyRangeToWord()
Dim objWord, N As Long
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.documents.Add
N = Cells(Rows.Count, "B").End(xlUp).Row
Range("B5:B" & N).Copy
With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range
'All formatting goes here
.PasteAndFormat (wdFormatPlainText)
End With
objWord.Visible = True
End Sub

How to temporarily open a Word document and use it to copy-paste a range?

I have formatted cells that I wish to copy and paste into an html form.
If I copy the contents to a Word document and paste them from there to an html form, it works.
If I copy the contents directly from the spreadsheet into the html form, the formatting is lost.
If the range is in the clipboard after copying from a Word document, I can paste it to the html form.
I need a way to copy the range to clipboard and retain the formatting. Since from Word it works, that's where I'm starting... but if there is another way...
I'm thinking of either an embed word file, or a hidden one.
Copy cell, paste there, select all and copy from there. Afterwards, close/discard it.
EDIT: Managed to get some code... but it worked, then stopped, then worked again... no idea why...
Sub TempDoc()
Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Application.ScreenUpdating = False
Set WDObj = Sheets("Text2Form").OLEObjects("WDOC")
WDObj.Activate
WDObj.Object.Application.Visible = False
Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.ActiveDocument
WDApp.Visible = False
Worksheets("Text2Form").Cells(12, 4).Copy
WDApp.Selection.Goto What:=wdGoToLine, Which:=wdGoToLast
WDApp.Selection.PasteSpecial xlPasteValues
WDApp.ActiveDocument.Content.InsertAfter vbNewLine
Worksheets("Text2Form").Cells(14, 4).Copy
WDApp.Selection.Goto What:=wdGoToLine, Which:=wdGoToLast
WDApp.Selection.PasteSpecial xlPasteValues
WDDoc.Content.Copy
WDDoc.Content.Delete
WDApp.Quit
Application.ScreenUpdating = True
End Sub
Have you tried right-clicking on the cell you wish to paste into, and clicking "Paste Special"?

Check if Word document closed from Excel VBA

I'm performing several prints of embedded Word document witch has some fields linked to some cells, by my PrintOut macro, in a For..Next loop, as below.
I need after each print task, that the program wait for document to close and then doing the next print.
In this situation I receive error. Can anyone help ?
Sub contract()
Dim i As Integer
For i = 1 To 100
Cells(Sheets("SheetName").ListObjects("StaffInfo").ListRows.Count + 9, 8).Value = i
General.PrintIt ("EmbeddedDoc") 'Doc has many linked fields
Next i
End Sub
Print method
Sub PrintIt(P As String)
Dim objWord As Object
Dim ObjDoc As Object
Dim Oshp As Object
Application.ScreenUpdating = False
ActiveSheet.OLEObjects(P).Activate
Set objWord = GetObject(, "Word.Application")
objWord.Visible = False
Set ObjDoc = objWord.ActiveDocument
ObjDoc.Fields.Update
For Each Oshp In ObjDoc.Content.ShapeRange
Oshp.TextFrame.TextRange.Fields.Update
Next
ObjDoc.PrintOut Background:=False
ObjDoc.PrintOut
objWord.Quit SaveChanges:=False
Application.ScreenUpdating = True
End Sub 'Print it
Introduced problem was solved by this code.
Above code do open and close embedded word document, 100 times, and that problem was happening in close document.
Exactly, I cant understand why closing document immediately after printout command that where after open and update fields, generating that error.
Thus I cleaned the problem ask!
By integrating "PrintIt" method in "Contract" method that is parent of that, without calling "PrintIt" for each document printout, embedded document opens each one, perform doc links updating and printing 100 times in for next loop and close word app and document, at last, each one too.
In short, I cant find reason of problem in several Open-Print-Close document in order immediately; But i change the algorithm to Open-Several print-Close and problem been cleaned!
Sub contract()
Application.ScreenUpdating = False
Sheets("SheetName").Unprotect
'Declare variables
Dim i As Integer
Dim objWord, ObjDoc As Object
'Core
ActiveSheet.OLEObjects("Contract").Activate
Set objWord = GetObject(, "Word.Application")
objWord.Visible = False
Set ObjDoc = objWord.ActiveDocument
For i = 1 To 100
Cells(x, y).Value = i 'A specific cell that
' word embedded document fields are linked to
'corresponding fields they values change
'by changing this cell.
ObjDoc.Fields.Update
ObjDoc.PrintOut Background:=False
ObjDoc.PrintOut
Next i
objWord.Quit SaveChanges:=False
Sheets("SheetName").Protect AllowFiltering:=True
End Sub

How to use Words selection methods through Excel VBA

In Word VBA you are able to set and move the cursor position by using the Selection.MoveLeft, Selection.MovRight etc...
However while trying to use this same method in Excel VBA I get an error saying "Object doesnt support this property or method."
I have imported the Word Object Library reference.
How am I able to move the cursor position on the Word document using VBA on the Excel application. Any help will be greatly appreciated.
Code:
Set Doc = ActiveDocument.Content
With Doc.Find
.Execute FindText:="*", ReplaceWith:="NEW*"
End With
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdParagraph, Count:=11
Selection.MoveRight Unit:=wdWord, Count:=4
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Font.Bold = False
Selection.Font.Name = "Arial"
Selection.Font.Size = 9
Your problem will go away if you would rephrase your question, "move the cursor position on the Word document using VBA on the Excel application". You can't move the cursor in a Word document using the Excel application.
When you open an Excel workbook you load an instance of the Excel application. You can use this same instance to open several workbooks. It also contains Excel VBA with all objects, methods and functions of the Excel application. This instance has no name.
But you could create another instance of the Excel application with code like
Dim XlApp as Excel.Application
Set XlApp = New Excel.Application
The new instance you have thus created has all the facilities of the first instance but is completely separate form it. You can open workbooks in it with code like
Dim Wb as workbook
Set Wb = XlApp.Workbooks.Add([Template])
Now, if you have set a reference to the MS Word Object Library you can create a Word application using similar code, for example,
Dim WdApp as Word.Application
Set WdApp = New Word.Application
This could be the only instance of MS Word running on your computer or it could be a new instance created in addition to other instances already running. This instance knows all the objects and methods of MS Word.
You can control both instances, XlApp and WdApp, in the same VBA project, but you should be careful to differentiate the objects. Both Excel and Word have a Range object for example. They are very different animals. You can specify, for example,
Dim xlRng As Excel.Range
Dim wdRng As Word.Range
Dim MyRng As Range
In this example, MyRng will be an Excel range if your VBA project is an Excel project. While you have both applications running this kind of defaulting will cause hair loss.
Dim Wb As Workbook
Dim Doc As Document
don't cause similar confusion because there is no Workbook object in MS Word and no Document object in MS Excel. VBA will use the correct application automatically, provided it is available.
When manipulating the WdRng you will have access to all the methods of the Word Range object, including Move, but there is no Address property, for example, which is a property of the XlRng.
Dealing with the two Selection objects is problematic. You will have to activate a window or document or workbook, and VBA will know which Selection object you mean by looking at the application running in the selected window. You won't have that problem if you specify the document/workbook object and use the WdRng or XlRng objects to manipulate your data.
As your code stands the keyword "selection" refers to the currently selected cell in excel, not the cursor position in your Word document. And the Excel Selection object does not have move methods. You might have more success using Range rather than selection: You example code translates as
With ActiveDocument
With .Content.Find
.Execute FindText:="*", ReplaceWith:="NEW*"
End With
with .Paragraphs(4).Range.Words(5).Font
.Bold = false
.name = "Arial"
.size = 9
end with
With .Paragraphs(4).Range.Words(6)
.Bold = false
.name = "Arial"
.size = 9
end with
end with
'Something Basic
'Session of word
'Existing document
Sub fromaWordDoc0()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Set wdApp = CreateObject("word.application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add("C:\Documents\words.docx")
With wdApp.Selection
wdApp.Selection.MoveRight Unit:=wdWord, Count:=4
End With
Set wdApp = Nothing: Set wdDoc = Nothing
End Sub

Copy and paste on new page

I am trying to write a code that copies the contents of multiple worksheets in a single workbook into a single word document. I want the content of each worksheet to be on its own page, but right now, my code is just copying and pasting over each other instead of going onto a new page and pasting. I've tried going to the end of the document but it isn't working... Any advice would be helpful.
Sub ToWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
Dim strdocname As String
'file name & folder path
On Error Resume Next
'error number 429
Set wdapp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'create new instance of word application
Set wdapp = CreateObject("Word.Application")
End If
wdapp.Visible = True
'define paths to file
strdocname = "C:\Doc.doc"
If Dir(strdocname) = "" Then
MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "C:\Doc.doc", vbExclamation, "The document does not exist "
Exit Sub
End If
wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Next ws
'Clean up
Set wddoc = Nothing
Set wdapp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
you can just use:
wddoc.Range(i).Paste
incrementing i by 1 after each image. that pastes them one after another.
or more simply:
wddoc.Range(wddoc.Characters.Count-1).Paste
then could get more complicated and add a page break manually in between each if images are small to ensure a new page for each:
wddoc.Range(wddoc.Characters.Count-1).InsertBreak Type:=7
https://msdn.microsoft.com/en-us/library/office/ff821608.aspx
EDIT
First, I incorrectly assumed the "wddoc.range" property would get wherever the cursor is. This is not true. You need to use the code provided by Miss Palmer (and replicated below).
However, there is an additional issue I didn't notice at first. Your loop is set incorrectly. You are looping through and continually reopening the word doc. You need to move these lines:
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
so that they are immediately above the
wddoc.Range(wddoc.Characters.Count - 1).Paste
line. This will cause the loop to be executed properly and only open the word doc once.
Also (again, per Miss Palmer), you want to put this:
wddoc.Range(wddoc.Characters.Count - 1).Paste
wddoc.Range(wddoc.Characters.Count - 1).InsertBreak (wdPageBreak)after the line:
instead of the ".range.paste" that you originially had.
The other issue with your "Selection" line is that you did not specify the application you wanted to use. This was using Excel's selection by default as it was being run from Excel.
This code assumes that you have a word document that doesn't have enough pages. Otherwise you could likely use the code you want, but it's unclear why you would have a blank word document with many pages. You'd still need to specify the app you want to move to the next page in, so put "wdapp." before the selection line.
http://word.tips.net/T000120_Jumping_to_the_Start_or_End_of_a_Document.html