I'm trying to copy a series of charts in one sheet to one document in word, but for some reason I only get the latest paste (meaning the last chart on the sheet). I know that the iteration goes through all charts, becausewhen I modofiy the code to print a single word doc for each chart it does so, but I want the charts together, so please help me out
The code:
Sub ChartsToWord()
Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim iCht As Integer
Dim Msg As String
Set WDApp = CreateObject("Word.Application")
Set WDDoc = WDApp.Documents.Add
For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
WDDoc.Content.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
WDDoc.Content.InsertParagraphAfter
Next
WDDoc.SaveAs ("C:\Users\confidential\Documents\charts.doc")
WDDoc.Close ' close the document
' Clean up
Set WDDoc = Nothing
Set WDApp = Nothing
End Sub
Please replace beginning of PasteSpecial line into:
WDApp.Selection.Range.PasteSpecial ... 'and so on
In your situation you paste chart into whole document instead of current paragraph.
One more suggestion. You could use the following to insert new paragraph:
WDApp.Selection.MoveEnd wdStory
WDApp.Selection.Move
Related
Let me preface this by saying I'm very new to VBA, so any help is appreciated.
I have been approached by someone to see if I can create a basic level of automation.
The need is to export data from Excel into Word with a button push.
The end goal is to have fields of data within excel such as "First name" "Surname" "Address"
"Contact Number". Then select say an entire row of a person (B1,B2,B3,B4) and when the Macro button is pressed, it opens a word document and pre-fills the fields into the document. It is to prefill letters for sending, this person has also stated that mail merge does not do what they need. Below is what I'm working with.
Sub ExcelToWord()
Dim wordApp As Word.Application
Dim mydoc As Word.Document
Set wordApp = New Word.Application
wordApp.Visible = True
Set mydoc = wordApp.Documents.Add()
ThisWorkbook.Worksheets("sheet1").Range("").Copy
mydoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
mydoc.SaveAs2 "MyDoc"
End Sub
This allows for a specific range such as (A2,B3) However not the "Selected" area.
I apologise if this is very basic but as I said, I don't really use VBA.
If I understanding your question, I think you only need to replace:
ThisWorkbook.Worksheets("sheet1").Range("").Copy
by:
Selection.Copy
It seems you need to use the Application.Selection property which returns the currently selected object on the active worksheet for an Application object.
Sub ExcelToWord()
Dim wordApp As Word.Application
Dim mydoc As Word.Document
Set wordApp = New Word.Application
wordApp.Visible = True
Set mydoc = wordApp.Documents.Add()
ThisWorkbook.Worksheets("sheet1").Activate()
Application.Selection.Copy()
mydoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
mydoc.SaveAs2 "MyDoc"
End Sub
So I'm trying to understand what is wrong with my code. All I'm doing is taking some charts in my Excel workbook and exporting them to a Word document but I keep getting an error if I try to paste them a certain way. Here's my code:
Sub ExportingToWord_MultiplePages2()
'Declare Word Variables
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
'Declare Excel Variables
Dim ChrtObj As ChartObject
'Create a new instance of Word
Set WrdApp = New Word.Application
WrdApp.Visible = True
'Create a new word document
Set WrdDoc = WrdApp.Documents.Add
'Loop through the charts on the active sheet
For Each ChrtObj In ActiveSheet.ChartObjects
'Copy the chart
ChrtObj.Chart.ChartArea.Copy
**'THIS WON'T RETURN AN ERROR**
With WrdApp.Selection
.PasteAndFormat Type:=wdChartPicture
End With
'**THIS WILL RETURN THE ERROR**
With WrdApp.Selection
.PasteAndFormat Type:=wdChartLinked
End With
'Clear the Clipboard.
Application.CutCopyMode = False
Next ChrtObj
End Sub
This is the weird part because I've provided two different ways to paste, the first one I paste it as a chart picture and that works fine. However, if I try wdChart or wdChartLinked it won't work! I get Error 4605 "Command Not Avaiable".
Any thoughts as to why this would be the case?
So I found a workaround to the problem, but I'm still not sure why PasteFormat will not work with a linked chart.
If I replace:
'**THIS WILL RETURN THE ERROR**
With WrdApp.Selection
.PasteAndFormat Type:=wdChartLinked
End With
With the following, I no longer get an error:
'**THIS WILL NOT RETURN AN ERROR**
With WrdApp.Selection
.PasteSpecial Link:=True, DataType:=wdPasteOLEObject
End With
I guess it has to do something with the format of the chart or something, but I still find it strange that I can paste it as a picture using PasteFormat but not as a linked chart.
I am trying to copy multiple Excel charts and paste them to a Word document, on separate pages, as the data type linked OLEObject but I am getting a run-time error.
Run-time error '5343':
Word cannot obtain the data for the
{00020832-0000-0000-C000-000000000046 link.
This is code that I've used in the past but literally, the only thing I changed in this code is to add an outer loop that processes the worksheets in the active workbook. Since adding that outer loop it no longer works, which is a little strange to me because I don't really see what is different.
It works for the first sheet (the currently active one), but fails when the loop moves to the next sheet. It does not matter whether the chart is pasted with or without a link.
Here is the full code for your reference:
Sub ExportingToWord_MultipleCharts()
'Declare Word Variables
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim SecCnt As Integer
'Declare Excel Variables
Dim ChrtObj As ChartObject
Dim Rng As Range
'Create a new instance of Word
Set WrdApp = New Word.Application
WrdApp.Visible = True
WrdApp.Activate
'Create a new word document
Set WrdDoc = WrdApp.Documents.Add
'Loop through each worksheet in the active workbook.
For Each WrkSht In ActiveWorkbook.Worksheets
'Loop through the charts on the active sheet
For Each ChrtObj In WrkSht.ChartObjects
'Copy the chart
ChrtObj.Chart.ChartArea.Copy
'Paste the Chart in the Word Document
With WrdApp.Selection
.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine
End With
'Add a new page to the document.
WrdApp.ActiveDocument.Sections.Add
'Go to the newly created page.
WrdApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
Next ChrtObj
Next WrkSht
End Sub
It returns the error on the following line:
'Paste the Chart in the Word Document
With WrdApp.Selection
.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine
End With
I found a workaround, but it still doesn't explain why the error is happening. What I had to do is activate the actual worksheet in the loop.
'***ACTIVATE THE WORKSHEET IN ORDER TO REMOVE THE ERROR***
WrkSht.Activate
For whatever reason, this seemed to remove the error from popping up. However, I find this strange because when I've exported charts from PowerPoint I am not required to activate the worksheet in order to copy it. Here is the code with the adjustments, I've called out the section I added.
Sub ExportingToWord_MultipleCharts()
'Declare Word Variables
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim SecCnt As Integer
'Declare Excel Variables
Dim ChrtObj As ChartObject
Dim Rng As Range
'Create a new instance of Word
Set WrdApp = New Word.Application
WrdApp.Visible = True
WrdApp.Activate
'Create a new word document
Set WrdDoc = WrdApp.Documents.Add
'Loop through each worksheet in the active workbook.
For Each WrkSht In ActiveWorkbook.Worksheets
'***ACTIVATE THE WORKSHEET IN ORDER TO REMOVE THE ERROR***
WrkSht.Activate
'Loop through the charts on the active sheet
For Each ChrtObj In WrkSht.ChartObjects
'Copy the chart
ChrtObj.Chart.ChartArea.Copy
'Paste the Chart in the Word Document
With WrdApp.Selection
.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement:=wdInLine
End With
'Add a new page to the document.
WrdApp.ActiveDocument.Sections.Add
'Go to the newly created page.
WrdApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
Next ChrtObj
Next WrkSht
End Sub
I have a Word document that is received periodically that needs to be combined with other data already in Excel as part of a larger output. I can copy and paste the whole document (WholeStory) from Word into Excel, but I want to make this part of the whole Excel output macro. My current code for this portion is below, and it works fine except that it pastes nothing. There is no data to paste when it gets there, so I guess it is either not picking it up to start with or not carrying it over. Looking for assistance with this. Thanks very much!
Sub ImportSectHWord()
Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
If wdFileName = False Then Exit Sub
Set objDoc = GetObject(wdFileName)
objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
Selection.Copy
Worksheets("H Import").Select
Range("A1").Select
ActiveSheet.Paste
objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
End Sub
The statement
Selection.Copy
is copying whatever is currently selected in Excel.
To copy the Selection object in Word, use
objWord.Selection.Copy
It is always advisable to qualify what objects you are referring to when using methods and properties, even when VBA provides a default object.
Sub ImportSectHWord()
'It is better to always define constants, even though they will default to zero
' which just happens to be the desired value in this case
Const wdDoNotSaveChanges As Long = 0
Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
If wdFileName = False Then Exit Sub
Set objDoc = GetObject(wdFileName)
objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy
ActiveWorkbook.Worksheets("H Import").Select
ActiveWorkbook.Worksheets("H Import").Range("A1").Select
ActiveWorkbook.ActiveSheet.Paste
objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
End Sub
I'm creating an Excel document that, among other things, copies a few arrays of data into a Word file.
Everything is working absolutely fine except that, when it pastes the selection I'm interested in, it pastes it infinitely until I intervene by taking down Word via Task Manager.
There is no reason, as far as I can see, for it to loop. So I'm pretty clueless of what to do next, and I was hoping you guys would shed a light into what I'm doing wrong. The concept is as follows:
Sub TestA()
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range
'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
'Opening app and document
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open("C:\Users\RCO1\Desktop\Teste VBA\2. Conceptual Testing\Export\XLWDTST.docx")
Set wdbmRange = wdDoc.Bookmarks("TableInsertion").Range
'Selecting array
Sheets("ExportMe").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pasting data
With wdbmRange
.PasteSpecial '<------- it simply goes back up to the beginning of the code at this point
CutCopyMode = False
End With
'Closing and saving
wdDoc.Save
wdDoc.Close
wdApp.Quit
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
Just note that I can't simply transform this array into a table so to speak for formatting reasons.
After placing a few inquiries, I have been given the following simple, yet very effective, piece of code:
Set wdApp = CreateObject("Word.Application")
Filepath = Sheets("Proposal Generator").Range("I9")
Set wdDoc = Word.Documents.Open(Filepath)
with wdDoc
Sheets("Shhet1").Cells(1).CurrentRegion.Copy
.Bookmarks("TableInsertion").Range.PasteExcelTable 0, 0, 0
.SaveAs (TxtSaveFolder.Text & "\" & TxtFileName.Text)
End With
I hope this works for anyone who's trying to export tables.