Consulting

Results 1 to 16 of 16

Thread: Pushing Charts and Ranges from Excel to Word

  1. #1
    Site Admin
    The Princess
    VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location

    Pushing Charts and Ranges from Excel to Word

    So I have a report with over a hundred charts and ranges that come from an Excel file. The problem is, that all the linking is very heavy on my Word doc and, in fact, not all the links update properly when I open the Word doc.

    I figure the best way around this is to PUSH these to Word, at bookmark locations as pictures instead.

    Can someone help?

    This question was posted elsewhere and for someone else. But I have seen it done and think it ought to be added to our KB. I have also informed the original questioner that I was going to post it.

    THANKS!!
    ~Anne Troy

  2. #2
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Out of curiosity, why are we using Word. Why can't the report be made in Excel?

  3. #3
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    1. Too much other text.
    2. Need different odd/even page headers.
    ~Anne Troy

  4. #4
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    ok.

    So what are the real names of the sheets in Excel. Or are the really named as they are here. Would making a summary sheet in Excel with all the sheet names in nice column be an option?

  5. #5
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    I am going to say yes. Here's the guy's actual Q:
    I have created a word document that contains many links from a dynamically populated excel workbook. It contains graphs and information in cells.

    I think I have reached a SECRET limit of linked items in the word document because it occasionally does not update some of the links. When I fix a link, it either corrupts itself, or allows a fix, but results in another SNEAKY link failing elsewhere.

    Please can someone help me with methods and solutions.

    The document is 73 pages long, with 900 links and 102 graphs. It is nicely formatted with odd and even pages and background images, hence the choice of applications.
    ~Anne Troy

  6. #6
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    How much do you love me?

    Check this out.

    Make sure to set a reference to MS Word Object Library.

    [VBA]
    Option Explicit

    Private Sub ExportToWord()

    Dim appWrd As Object
    Dim objDoc As Object
    Dim FilePath As String
    Dim FileName As String
    Dim x As Long
    Dim LastRow As Long
    Dim SheetChart As String
    Dim SheetRange As String
    Dim BookMarkChart As String
    Dim BookMarkRange As String

    FilePath = ThisWorkbook.Path
    FileName = "WorkWithExcel.doc"
    LastRow = Sheets("Summary").Range("A65536").End(xlUp).Row
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    On Error Resume Next
    Set objDoc = appWrd.Documents.Open(FilePath & "\" & FileName)
    On Error GoTo 0
    If objDoc Is Nothing Then
    MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
    appWrd.Quit
    Set appWrd = Nothing
    Exit Sub
    End If
    For x = 2 To LastRow
    SheetChart = ThisWorkbook.Sheets("Summary").Range("A" & x).Text
    SheetRange = ThisWorkbook.Sheets("Summary").Range("B" & x).Text
    BookMarkChart = ThisWorkbook.Sheets("Summary").Range("C" & x).Text
    BookMarkRange = ThisWorkbook.Sheets("Summary").Range("D" & x).Text

    appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkRange
    ThisWorkbook.Sheets(SheetRange).UsedRange.Copy
    appWrd.Selection.Paste
    appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkChart
    ThisWorkbook.Sheets(SheetChart).ChartObjects(1).Copy
    appWrd.Selection.Paste
    Next

    End Sub

    [/VBA]

  7. #7
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    Let me COUNT THE WAYS!!
    Okay. I'm gonna alert this guy...
    ~Anne Troy

  8. #8
    VBAX Mentor XL-Dennis's Avatar
    Joined
    May 2004
    Location
    ?stersund, Sweden
    Posts
    499
    Location
    And add a msgbox in the end so the user know when the process is finish as well

    BTW, add also some With-statement and after that DB may send You some flowers

    Kind regards,
    Dennis
    Kind regards,
    Dennis

    ExcelKB | .NET & Excel | 2nd edition PED


  9. #9
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    Don't forget to cleanup ...

    Set appWrd = Nothing
    Set objDoc = Nothing

    Nice one Jake!

  10. #10
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Ok, I added a bit to make you all happy.

    [VBA]
    'You must set a reference to Microsoft Word Object Library from Tools | References

    Option Explicit

    Sub ExportToWord()

    Dim appWrd As Object
    Dim objDoc As Object
    Dim FilePath As String
    Dim FileName As String
    Dim x As Long
    Dim LastRow As Long
    Dim SheetChart As String
    Dim SheetRange As String
    Dim BookMarkChart As String
    Dim BookMarkRange As String
    Dim Prompt As String
    Dim Title As String

    'Turn some stuff off while the macro is running
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    'Assign the Word file path and name to variables
    FilePath = ThisWorkbook.Path
    FileName = "WorkWithExcel.doc"

    'Determine the last row of data for our loop
    LastRow = Sheets("Summary").Range("A65536").End(xlUp).Row

    'Create an instance of Word for us to use
    Set appWrd = CreateObject("Word.Application")

    'Open our specified Word file, On Error is used in case the file is not there
    On Error Resume Next
    Set objDoc = appWrd.Documents.Open(FilePath & "\" & FileName)
    On Error GoTo 0

    'If the file is not found, we need to end the sub and let the user know
    If objDoc Is Nothing Then
    MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
    appWrd.Quit
    Set appWrd = Nothing
    Exit Sub
    End If

    'Copy/Paste Loop starts here
    For x = 2 To LastRow

    'Use the Status Bar to let the user know what the current progress is
    Prompt = "Copying Data: " & x - 1 & " of " & LastRow - 1 & " (" & _
    Format((x - 1) / (LastRow - 1), "Percent") & ")"
    Application.StatusBar = Prompt

    'Assign the worksheet names and bookmark names to a variable
    'Use With to group these lines together
    With ThisWorkbook.Sheets("Summary")
    SheetChart = .Range("A" & x).Text
    SheetRange = .Range("B" & x).Text
    BookMarkChart = .Range("C" & x).Text
    BookMarkRange = .Range("D" & x).Text
    End With

    'Tell Word to goto the bookmark assigned to the variable BookMarkRange
    appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkRange

    'Copy the data from Thisworkbook
    ThisWorkbook.Sheets(SheetRange).UsedRange.Copy

    'Paste into Word
    appWrd.Selection.Paste

    'Tell Word to goto the bookmark assigned to the variable BookMarkChart
    appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkChart

    'Copy the data from Thisworkbook
    ThisWorkbook.Sheets(SheetChart).ChartObjects(1).Copy

    'Paste into Word
    appWrd.Selection.Paste
    Next

    'Turn everything back on
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.StatusBar = False

    'Let the user know the procedure is now complete
    Prompt = "The procedure is now completed." & vbCrLf & vbCrLf & "www.VBAExpress.com"
    Title = "Procedure Completion"
    MsgBox Prompt, vbOKOnly + vbInformation, Title

    'Make our Word session visible
    appWrd.Visible = True

    'Clean up
    Set appWrd = Nothing
    Set objDoc = Nothing

    End Sub

    [/VBA]

  11. #11
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    Jake, can you please add this to the KB.
    This is TOO cool.
    ~Anne Troy

  12. #12
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Ok, its added. Can you review/approve it?

  13. #13
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    User can't get it to work and neither can I.
    What are we doing wrong?
    ~Anne Troy

  14. #14
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    Sorry. To clarify: It pastes the same large area of the worksheet at EVERY bookmark.
    ~Anne Troy

  15. #15
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    The way you have it setup now is not the way it was originally, so there is your problem. It started with the charts on one sheet and the range on the other, but now with them both combined all on one sheet.

    We can still work with this, but I really need to know how the data is actually layed out in Excel.

  16. #16
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Ok, I made some changes. The user will need to specify the sheet and the range address or chart name as well as the corrosponding bookmark. It seems to work fine. In the attachment, the bookmarks are not setup well in Word so the chart overlaps the data, but the chart is at the correct bookmark.


    [vba]

    'You must set a reference to Microsoft Word Object Library from Tools | References

    Option Explicit

    Sub ExportToWord()

    Dim appWrd As Object
    Dim objDoc As Object
    Dim FilePath As String
    Dim FileName As String
    Dim x As Long
    Dim LastRow As Long
    Dim SheetName As String
    Dim BookMarkName As String
    Dim Prompt As String
    Dim Title As String
    Dim ChartName As String
    Dim RangeAddress As String

    'Turn some stuff off while the macro is running
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    'Assign the Word file path and name to variables
    FilePath = ThisWorkbook.Path
    FileName = "report1.doc" '"WorkWithExcel.doc"

    'Determine the last row of data for our loop
    LastRow = Sheets("Summary").Range("A65536").End(xlUp).Row

    'Create an instance of Word for us to use
    Set appWrd = CreateObject("Word.Application")

    'Open our specified Word file, On Error is used in case the file is not there
    On Error Resume Next
    Set objDoc = appWrd.Documents.Open(FilePath & "\" & FileName)
    On Error GoTo 0

    'If the file is not found, we need to end the sub and let the user know
    If objDoc Is Nothing Then
    MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
    appWrd.Quit
    Set appWrd = Nothing
    Exit Sub
    End If

    'Copy/Paste Loop starts here (For Charts)
    For x = 2 To LastRow

    'Use the Status Bar to let the user know what the current progress is
    Prompt = "Copying Charts: " & x - 1 & " of " & LastRow - 1 & " (" & _
    Format((x - 1) / (LastRow - 1), "Percent") & ")"
    Application.StatusBar = Prompt

    'Assign the worksheet names and bookmark names to a variable
    'Use With to group these lines together
    With ThisWorkbook.Sheets("Summary")
    SheetName = .Range("A" & x).Text
    BookMarkName = .Range("B" & x).Text
    ChartName = .Range("C" & x).Text
    End With

    'Tell Word to goto the bookmark assigned to the variable BookMarkRange
    appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkName

    'Copy the Chart from Thisworkbook
    ThisWorkbook.Sheets(SheetName).ChartObjects(ChartName).Copy

    'Paste into Word
    appWrd.Selection.Paste

    Next

    LastRow = Sheets("Summary").Range("D65536").End(xlUp).Row

    'Copy/Paste Loop starts here (For Data)
    For x = 2 To LastRow

    'Use the Status Bar to let the user know what the current progress is
    Prompt = "Copying Data: " & x - 1 & " of " & LastRow - 1 & " (" & _
    Format((x - 1) / (LastRow - 1), "Percent") & ")"
    Application.StatusBar = Prompt

    'Assign the worksheet names and bookmark names to a variable
    'Use With to group these lines together
    With ThisWorkbook.Sheets("Summary")
    SheetName = .Range("D" & x).Text
    BookMarkName = .Range("E" & x).Text
    RangeAddress = .Range("F" & x).Text
    End With

    'Tell Word to goto the bookmark assigned to the variable BookMarkRange
    appWrd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkName

    'Copy the Chart from Thisworkbook
    ThisWorkbook.Sheets(SheetName).Range(RangeAddress).Copy

    'Paste into Word
    appWrd.Selection.Paste

    Next

    'Turn everything back on
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.StatusBar = False

    'Let the user know the procedure is now complete
    Prompt = "The procedure is now completed." & vbCrLf & vbCrLf & "www.VBAExpress.com"
    Title = "Procedure Completion"
    MsgBox Prompt, vbOKOnly + vbInformation, Title

    'Make our Word session visible
    appWrd.Visible = True

    'Clean up
    Set appWrd = Nothing
    Set objDoc = Nothing

    End Sub

    [/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •