How can we copy InlineShape objects for one document to another?

Question

I am trying to put together some code that loops through a bunch of slave word documents in a folder, opens each, copies out the InlineShapes from each slave document, and paste it into a master word document. Below is a sample of the code that I've come up with, but it's not working correctly.

Dim objShape As objInlineShape

Path = "C:\Users\WordDocs\"
File = Dir(Path & ".")

Do While File <> ""

Set aDoc = Documents("Master.docm")
Set oDoc = Documents.Open(FileName:=Path & File)

For Each objShape In ActiveDocument.InlineShapes
If objShape.HasChart Then
objShape.Chart.Select
Selection.Copy
aDoc.Activate
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagrpah
End if
Next

oDoc.Close SaveChanges:=False
File = Dir()
Loop

When I run this code, it seems like the master document does find the the chart in the slave document, and it seems to copy just one chart, but then it skips all the other charts, and moves to the next slave document, open that, copies one chart, even though there are several, closes the file, and so on and so forth. What's wrong with my code, and how can I get it to copy ALL charts in ALL slave documents? Thanks.

Answer 1

You code would require my to do some setup of multiple dummy documents to test, so instead I'm hazarding some guesses.

For a start, you haven't used Dim oDoc as document.

Then you set oDoc to a document you open.

Then, in the For Each objShape line, you don't use the reference to oDoc, but switch to ActiveDocument. You should fix both of these problems.

When you activate the receiving document, you are using the Selection object instead of the Range object. Most likely, this is because you created the macro with the macro recorder.

The Selection object is less reliable than Range. Using Selection, it's possible you are over-writing each pasted chart with the next pasted chart. After
Selection.TypeParagraph
add
Selection.Collapse Direction:=wdCollapseEnd
to prevent that from happening.

Answer 2

Final solution.

Sub CopyAllCharts()

Dim objShape As InlineShape
Dim mDoc As Document
Dim sDoc As Document

Path = "C:\Users\ryans\Desktop\word_docs\"
File = Dir(Path & ".")

Do While File <> ""

Set mDoc = Documents("Control One Word Document From Another Word Document.docm")
Set sDoc = Documents.Open(FileName:=Path & File)

Windows(sDoc).Activate
Debug.Print ActiveDocument.Name

For Each objShape In sDoc.InlineShapes
    Debug.Print ActiveDocument.Name
    Debug.Print objShape.HasChart

    If objShape.HasChart Then
        objShape.Chart.Select
        Selection.Copy
        Windows(mDoc).Activate
        Debug.Print ActiveDocument.Name
        Selection.PasteAndFormat (wdPasteDefault)
        Selection.Collapse Direction:=wdCollapseStart
    End If

Windows(sDoc).Activate
Debug.Print ActiveDocument.Name
Next objShape

sDoc.Close SaveChanges:=False
File = Dir()
Loop

End Sub