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
Related
I wish I could just copy straight from excel but the program that I am copying into doesn't allow that.
This is what I have so far.
Sub exceltoword()
Dim RangeToCopy As Range
Set RangeToCopy = Range("A2")
Dim WordApp As Word.Application
Set WordApp = New Word.Application
WordApp.Visible = True
Dim WordDoc As Word.Document
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
WordDoc.Close
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Application.Wait (Now + TimeValue("0:00:005"))
Set RangeToCopy = Range("B2")
Set WordApp = New Word.Application
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
With a simple google search of how to copy from excel to word is where I found the below, I added comments that tell you where to change variables, you can add multiple tables pasted to any bookmarks you set in word, make sure you set your references.
your code will look something like this after you declare you word application
Option Base 1 'Force arrays to start at 1 instead of 0
Sub ExcelTablesToWord()
'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
(VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com
Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim TableArray As Variant
Dim BookmarkArray As Variant
'List of Table Names (To Copy)
TableArray = Array("MAKE YOUR TABLE ARRAY IN EXCEL AND PUT THE NAME HERE",)
'List of Word Document Bookmarks (To Paste To - in word goto Insert->Bookmark)
BookmarkArray = Array("BOOKMARK NAME FROM MICROSOFT WORD DOC HERE")
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set Variable Equal To Destination Word Document
On Error GoTo WordDocNotFound
Set WordApp = GetObject(class:="Word.Application")
WordApp.Visible = True
Set myDoc = WordApp.Documents("FULL FILE PATH TO YOUR WORD DOCUMENT")
On Error GoTo 0
'Loop Through and Copy/Paste Multiple Excel Tables
For x = LBound(TableArray) To UBound(TableArray)
'Copy Table Range from Excel
Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
tbl.Copy
'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(x)
WordTable.AutoFitBehavior (wdAutoFitWindow)
Next x
'Completion Message
MsgBox "Copy/Pasting Complete!", vbInformation
GoTo EndRoutine
'ERROR HANDLER
WordDocNotFound:
MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently open, aborting.", 16
'Put Stuff Back The Way It Was Found
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Basically you set your variables to the word application, define the arrays you want to paste in your excel sheet (in your instance B5?) then it will loop through and paste your arrays to the Bookmarks you set in your word document, which you can set to any location in your word document.
I have an Excel sheet with Microsoft Word OLE objects embedded.
My embedded Word documents have some fields that should been updated with specific cells.
I need to print the content of that embedded document, without visible document opening and "update document prompts".
My problem is in copying the content of the Word-embedded OLE object in an invisible Word document without update prompting.
I try this:
This code paint a box around the embedded word document in destination printable document.
Please help me copy content of embedded document or ..., and print an embedded document without updating prompt and visible window.
Sub PrintIt(P As String, w, h As Double)
Dim objWord As Object
Dim ObjDoc As Object
Application.ScreenUpdating = False
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
ActiveSheet.OLEObjects(P).Copy
Set ObjDoc = objWord.Documents.Add
ObjDoc.PageSetup.PageWidth = objWord.CentimetersToPoints(w)
ObjDoc.PageSetup.PageHeight = objWord.CentimetersToPoints(h)
ObjDoc.Content.Paste
ObjDoc.PrintOut Background:=False
ObjDoc.PrintOut
objWord.Quit SaveChanges:=False
Application.ScreenUpdating = True
End Sub 'Print it
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
How to run macro in word without opening it.
I went through same question asked before.
Solution is:
Dim Word
Dim WordDoc
Set Word = CreateObject("Word.Application")
Word.Visible = False
Set WordDoc = Word.Documents.open("D:\working_folder\abc.doc")
Word.Run "<macroname>"
WordDoc.Save
Word.Quit
Set WordDoc = Nothing
Set Word = Nothing
This is working well for me too but in this case file name is specific ("abc.doc").
What if I want to run macro for all word files which are in the same folder?
The Macro is defined in all those files, I just want to know how to get all filenames in a folder.
Untested, but something like this:
Dim Word, fldr, f
Dim WordDoc
Set Word = CreateObject("Word.Application")
Word.Visible = False
fldr = "D:\working_folder\"
f = Dir(fldr & "*.doc*")
Do while f<>""
Set WordDoc = Word.Documents.open(fldr & f)
Word.Run "<macroname>"
WordDoc.Save
WordDoc.Close
f = Dir()
Loop
Word.Quit
Set WordDoc = Nothing
Set Word = Nothing
You can't run a macro without opening the file which contains it though.
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!
I'm trying to copy and paste each worksheet in a workbook onto a new sheet in a single Word document. Unfortunately it is only copying the contents of the first worksheet, though it does seem to be looping through all the worksheets. I thought that inserting a page break would work but it isn't. It also won't let me format it in Word. I want the contents of A1 to have a header style.
This is my code:
Sub ExceltoWord()
Dim ws As Worksheet
Dim Wkbk1 As Workbook
Set Wkbk1 = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each ws In Wkbk1.Worksheets
Wkbk1.ActiveSheet.Range("A1:A2").Copy
Dim wdapp As Object
Dim wddoc As Object
Dim Header As Range
'file name & folder path
Dim strdocname As String
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 = "P:\ImportedDescriptions.doc"
If Dir(strdocname) = "" Then
MsgBox "The file" & strdocname & vbCrLf & "was not found " & vbCrLf & "P:\ImportedDescriptions.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)
Set Header = Range("A1")
'must activate to be able to paste
wddoc.Activate
wddoc.Range.Paste
Selection.WholeStory
Header.Style = ActiveDocument.Styles("Heading 2")
Selection.InsertBreak Type:=wdPageBreak
Next ws
wddoc.Save
'wdapp.Quit
Set wddoc = Nothing
Set wdapp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
You are only copying from the active worksheet, which happens to be the first sheet in your case. Instead of:
For Each ws In ActiveWorkbook.Worksheets
ActiveWorkbook.ActiveSheet.Range("A1:A2").Copy
use:
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1:A2").Copy
This will copy each range in turn.
I think it is losing track of which workbook you started with when you activate Word. Save your workbook to a Workbook variable (i.e. Dim Wkbk1 As Workbook, Set Wkbk1 = ActiveWorkbook) then replace every instance of ActiveWorkbook in your code after that with Wkbk1 (in your For Each loop and every time you want to reference it inside the loop as well).