View Single Post
 
Old 05-28-2018, 08:21 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

if you add the following macro to the documents whose content you want to insert the charts after, then run the macro and select the charts document, it should insert the charts into the document you're running the macro from. As I indicated, though, you're liable to get different results if you run the macro on a different computer.
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Dim i As Long, RngSrc As Range, RngTgt As Range
Set DocTgt = ActiveDocument
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source file"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
  Else
    MsgBox "No source file selected. Exiting", vbExclamation
    Exit Sub
  End If
End With
With DocSrc
  For i = .ComputeStatistics(wdStatisticPages) To 1 Step -1
    Set RngSrc = .Range.GoTo(What:=wdGoToPage, Name:=i)
    Set RngSrc = RngSrc.GoTo(What:=wdGoToBookmark, Name:="\page")
    Set RngTgt = DocTgt.Range.GoTo(What:=wdGoToPage, Name:=i)
    Set RngTgt = RngTgt.GoTo(What:=wdGoToBookmark, Name:="\page")
    RngTgt.Characters.Last.FormattedText = RngSrc.FormattedText
  Next
  .Close SaveChanges:=False
End With
ErrExit:
Set RngSrc = Nothing: Set RngTgt = Nothing
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote