Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & tables)

ZappAstrim · Aug 15th 2011

Hello everyone - I have managed to use Mr. Plow's fantastic script for using a VBA script to cycle through Word bookmarks and insert Excel range value. I have managed to get the script to work fantastically on text only copies. However I would also like to copy and paste charts as well as tables from named ranges. I was wondering how I could achieve this with a modification of the script that is found in this thread:

http://www.ozgrid.com/forum/showthread.php?t=148798&page=1 (post number 6)

Currently when I try to "autocopy" from a range that is a table I get the error: "Run-time error '94': "Invalid use of Null" on the following line:
strValue = Trim(Application.Range(strName).Text)

I don't believe it should be too hard to modify the script, but all my attempts have failed so far. If someone could advise me at least where I could start looking that would be fantastic.

RichardW · Aug 15th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

I had a project where I created a Report with data from Excel and this code worked well. There should be enough to give you some hints on the format.

Code

Set ScoreTitle = Range("ScoreTitle1")
    objDoc.Bookmarks.Item("ScoreTitle").Range.InsertAfter ScoreTitle
    appWrd.Selection.Goto What:=wdGoToBookmark, Name:="ScoreDistributionChart"
    ThisWorkbook.Sheets("Score Distribution").ChartObjects(1).Copy
    appWrd.Selection.Paste
    appWrd.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Code

appWrd.Selection.Goto What:=wdGoToBookmark, Name:="BookmarkName"
        ThisWorkbook.Sheets("SheetName").Activate
        Range("A1").Select
        ActiveCell.CurrentRegion.Copy
        appWrd.Selection.Paste
        appWrd.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter

ZappAstrim · Aug 15th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Thanks for the extra code Richard. I still however have the issue with the current code that I am trying to run. I get stuck on this line with the code that I am using from the post that I referenced. It's fantastic code as it does the following:

Looks for bookmarks in word document and lists them in memory. Finds ranges in excel with the same name. Automatically copies these ranges and re-inserts the bookmark. The code is SUPER fast and the formatting for text is fantastic. But I just don't understand how I can adapt it for use with tables and charts.

This is the line I truly don't understand as to what it does and how to get around it:

strValue = Trim(Application.Range(strName).Text)

I keep on getting the error 94 and I am starting to go mad!

RichardW · Aug 15th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Trim(strName) takes out any spaces from the string strName but it can only do that if strName has been assigned a value, so ask how does strName get its value. You need to step through the code one line at a time using the F8 function key on your keyboard, when you mouse over a variable you should see a value appear or you can bring up the Locals window to see what has been assigned to each variable at each stage of the program. If you are still having problems attach a file so I can get a better picture of what you are trying to do.

Richard

ZappAstrim · Aug 16th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Thanks again for all your support Richard.

I went and cycled through the code as you suggested. The issue I am having is that the tables and charts I am trying to copy are not text. So I end up with this part of the code giving me a null value:

(Application.Range(strName).Text)

I somehow need to be able to distinguish between text, charts and tables in order to be able to copy them into my report. Unfortunately I am still very much a beginner at coding VBA and am unsure of how this can be best achieved.

strName in this case is the Named Range/Bookmark for the table in the report (ARTableFruit in the attached example).

RichardW · Aug 16th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Your homework? tut tut tut
Attached is the Excel workbook with new code in Module 2 and a word template that must live in the same folder. NOTE you must rename Fruit1.doc to Fruit1.dotx. I couldn't see the file with the new extension in the attachment portal and had to rename it to Fruit1.doc
This is slightly different in that it uses a template. Make a copy of the template, it is easy to end up with an open file when your code crashes and does not close the Word file, always manually open and close the Word file after a crash to ensure its closed properly.
You can add error trapping and any other functionality as needed.
You'll note how different my simple code is compared to Mr Plows. He obviously had a need to do what he did, your trying to adapt his code without understanding it caused you grief. That said someone better than me would likely critique my code, we're all learning.

Regards
Richard

The code for those interested:

Code

Public Sub SendToWord()
    
Dim wdDoc As Word.Document, objDoc As Word.Document, wdApp As Word.Application
Dim VARPersonA As Excel.Range, VARPersonB As Excel.Range, VARPersonC As Excel.Range
Dim VARFruitA As Excel.Range, VARFruitB As Excel.Range, VARFruitC As Excel.Range
Dim VARTotalFruit As Excel.Range
Set wdApp = New Word.Application
'Assign the Word file path and name to variables
FilePath = ThisWorkbook.Path
FileName = "Fruit1.dotx"
Set objDoc = wdApp.Documents.Add(Template:=FilePath & "\" & FileName)
If objDoc Is Nothing Then
    MsgBox "Unable to find the Word file.", vbCritical, "File Not Found"
    wdApp.Quit
    Set appWrd = Nothing
    Exit Sub
End If
        
Set VARPersonA = Range("ARPersonA")
Set VARPersonB = Range("ARPersonB")
Set VARPersonC = Range("ARPersonC")
Set VARFruitA = Range("ARFruitA")
Set VARFruitB = Range("ARFruitB")
Set VARFruitC = Range("ARFruitC")
Set VARTotalFruit = Range("ARTotalFruit")


With objDoc.Bookmarks
    .Item("ARPersonA").Range.InsertAfter VARPersonA
    .Item("ARPersonB").Range.InsertAfter VARPersonB
    .Item("ARPersonC").Range.InsertAfter VARPersonC
    .Item("ARTotalFruit").Range.InsertAfter VARTotalFruit
    .Item("ARFruitA").Range.InsertAfter VARFruitA & "s" 'add the s to Apple
    .Item("ARFruitB").Range.InsertAfter VARFruitB & "s"
    .Item("ARFruitC").Range.InsertAfter VARFruitC & "s"
End With
wdApp.Selection.Goto What:=wdGoToBookmark, Name:="ARTableFruit"
ThisWorkbook.Sheets("Sheet1").Range("B3:D7").Copy
wdApp.Selection.Paste
wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowLeft
        
wdApp.Selection.Goto What:=wdGoToBookmark, Name:="ARChartFruit"
ThisWorkbook.Sheets("Sheet1").ChartObjects(1).Copy
wdApp.Selection.Paste
wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
'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 = "Click OK to Review the Fruit Report Document in the Taskbar."
Title = "Procedure Completion"
MsgBox Prompt, vbOKOnly + vbInformation, Title
'Make our Word session visible
wdApp.Visible = True
wdApp.ActiveDocument.SaveAs FilePath & "\" & " Fruit Report.docx"
'Clean up
Set wdApp = Nothing
Set objDoc = Nothing
       
End Sub

Display More

ZappAstrim · Aug 17th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Hello Richard. Many thanks for your support. Actually the document I put together was just an example of what I need to be able to do.

Your code is nice and I can understand most of it. Unfortunately it doesn't quite do what I need it to. I'm really sorry to say this as I really appreciate all your help that you have provided me so far.

The nice thing about the code that Mr. Plow provided is that you don't need to manually provide all the bookmark names and named ranges and is very universal. The word document that I use in combination with the Excel file might not just be created once, but also updated if any changes occur in the word document. There are quite a lot of tables and charts in the report. Sometimes some of the tables might be removed as they are not required and then the corresponding bookmark would be removed too - so I can't go around updating the VBA manually as this would take more time than a manual copy paste job.

I'm scratching my head at the moment as to what I can do to make some universal code that will work nicely with updating and also to copy charts and tables. I've bought myself Excel VBA for Dummies and have now started reading that in the hope of being able to come up with a nice solution.

I'll definitely come back here when I have a result. If you (Richard), or anyone else, has any further ideas I am always appreciative.

Thanks so much for all your help and support!

RichardW · Aug 17th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

So that we are not guessing, make a list of several scenarios of what you might be faced with. If you have a variable number of Text, Tables & Charts how did you propose that Excel would grab them. Its a bit hard not seeing the full picture.

ZappAstrim · Aug 18th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Hello Richard.

I know that Excel can grab all Named Ranges. So I have around 10 tables that need copying from Excel to word and around 10 charts that need copying too. Added to that there are probably around 10 text strings that need copying. Ideally I could do it by loading the list of bookmarks from Word:

Code

With wdDoc        ReDim sbkmk(1 To .Bookmarks.Count)
         
         'populates array (a list) with bookmark names
        For tmp1 = 1 To .Bookmarks.Count
            sbkmk(tmp1) = .Bookmarks(tmp1).Name
        Next

So now I have the list of bookmarks in the word document where I would like to insert various bits of text, tables or graphs from my Excel document. If the bookmark has the same name as a named range I should be able to match these.

I know that I can load the text in a String as the code by Mr. Plow does this. I was wondering if there is a way that I can load an excel chart into something like a string or a variable, hold it in memory and then dump it into where the word document bookmark is.

I know what format each Bookmark is going to be in so I could create a list something like this:

Code

'Insert all text items
For "ARText1", "ARText2", "ARText3" etc.
     Use Function "Insert Text"  
'Insert all chart items
 For "ARChart1", "ARChart2", "ArChart3" etc. 
     Use Function "Insert Chart"
'insert all tables
For  "ARTable1", "ARTable2", "ArTable3" etc. 
     Use Function "Insert Table"

(This is obviously not real code)

Mr Plow uses the following Function to insert text, so we have this covered:

Code

Sub FillBookmark(ByRef wdDoc As Object, ByVal vValue As Variant, ByVal sBmName As String, Optional sFormat As String)    Dim wdRng As Object
     
     'store the bookmarks range
    Set wdRng = wdDoc.Bookmarks(sBmName).Range
    
     'if the optional format wasn’t supplied
    If Len(sFormat) = 0 Then
         'replace the bookmark text
        wdRng.Text = vValue
    Else
         'replace the bookmark text with formatted text
        wdRng.Text = Format(vValue, sFormat)
    End If
     
     're-add the bookmark because earlier process destroyed it
    wdRng.Bookmarks.Add sBmName, wdRng
    
    
End Sub

Display More

The important part of this function is that it re-adds the bookmark allowing the user to update the word document at a future point in time. So the bookmark needs to cover the entire word, chart or table when updating.

The biggest problem I have with Mr Plow's code is the following item:

Code

strValue = Trim(Application.Range(strName).Text)

I am unsure of how one could modify this code to work with charts or tables, or whether that is even possible or not.

RichardW · Aug 18th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

So why not use a template that has the bookmarks placed where you want your content, everytime you want to update the document just rewrite it from Excel, have as much variable content in Excel as you can, have content that never changes in the template, have purposely named bookmarks in the right sections of your template.
If you have different content at different times write code that allows a selection process ie a userform with checkboxes. Send only the text, charts & tables you want to their respective bookmarks, at worst you have to go into the finished document and do a little formatting ie delete blank pages where the bookmarks wern't populated. Consider also a system where you could have numerous templates with the bookmarks placed in different ways or order to select from.
Thats just my opinion, I find I develop a system, get it going and then look for ways to improve it. In this way you learn a bit more about the complete picture rather than trying to develop the perfect system straight up and then realising issues. I have no doubt there is scope to build a system thats smart about collecting and assigning range names to bookmarks.
The code I provided will do what you need, you just have to build in some If statements around selection of content.
If I had time I would setup Mr Plows code and step through it to understand where you are having issues with that line of code, strName is obviously not getting a value earlier on in the procedure.
Hope this helps.
Richard

ZappAstrim · Aug 22nd 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Hi Richard. I just wanted to let you know that I managed to do it!!! I can now copy and paste tables and text with great formatting results. All there needs to be is a bookmark in the word document and a named range in excel with the same.

I will post the code here shortly. It's a bit of a mess at the moment and could probably really do with a good clean-up. I'll try as best I can to make the code readable and then post it here in the next couple of days.

ZappAstrim · Aug 23rd 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Please be prepared for some horrendously crap code:

Code

Sub AutoReport1()


Dim wdApp           As New Word.Application
Dim wdDoc           As Word.Document
Dim FilePath        As String
Dim FileName        As String
Dim n               As Long
Dim p               As Long
Dim pcount          As Long
Dim x               As Long
Dim SheetChart      As String
Dim SheetRange      As String
Dim Prompt          As String
Dim Title           As String
Dim StrDoc          As String
Dim BkmNo           As Long
Dim temp            As Variant
Dim MyRange         As Word.Range
Dim BkmTxtSplit     As Variant
Dim BkmChartSplit   As Variant
Dim wdRng           As Object




    'X must be higher than the number of bookmarks in the word document
    x = 100
    'P Must be around 5 times higher than x as it is used as a progress indicator
    pcount = 500
    
    'On Error GoTo ErrorHandler
       
    'Things to make sure that the application runs properly
    With ThisWorkbook
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False




    'Assign the Word file path and name to variables
    Set wdApp = Nothing
    FilePath = ThisWorkbook.Path
    FileName = Range("AR_ReportName")
    StrDoc = FilePath & "\" & FileName
    
    Set wdDoc = wdApp.Documents.Open(StrDoc)
   
   'populates array with bookmark names
    With wdDoc
    ReDim BkmNames(1 To wdDoc.Bookmarks.Count)
        For BkmNo = 1 To wdDoc.Bookmarks.Count
            BkmNames(BkmNo) = wdDoc.Bookmarks(BkmNo).Name
        Next
    End With
    'wdApp.Visible = True








    'creates an array with all the Bookmarks that are text based
    n = 0
    p = 1
    
    ReDim BkmTxt(1 To x)
    For Each temp In BkmNames
        n = n + 1
        'All bookmarks That are related to text strings must start with ARText.
        If Left(BkmNames(n), 5) = "ARTex" Then
           BkmTxt(n) = BkmNames(n)
        End If
    Next
    
    'creates an array with all the Bookmarks that are table based
    n = 0
    ReDim BkmTable(1 To x)
    For Each temp In BkmNames
        n = n + 1
        p = p + 1
        'All bookmarks That are related to tables must start with ARTable.
        If Left(BkmNames(n), 5) = "ARTab" Then
           BkmTable(n) = BkmNames(n)
        End If
    Next
    
    'creates an array with all the Bookmarks that are table based
    n = 0
    ReDim BkmChart(1 To x)
    For Each temp In BkmNames
        n = n + 1
        p = p + 1
        'All bookmarks That are related to chart objects must start with ARChart.
        If Left(BkmNames(n), 5) = "ARCha" Then
           BkmChart(n) = BkmNames(n)
        End If
    Next
    
    
    'PASTE TEXT STRINGS LOOP
        n = 0
    For Each temp In BkmTxt
        n = n + 1
        p = p + 1
        
        Prompt = "Please wait. Carrying out operation " & p & " of roughly " & pcount & ""
        Application.StatusBar = Prompt
        
        'If The Bkmtxt(n) is empty then go to the next one, once that has been found do next operation.
        If BkmTxt(n) = Empty Then
            n = n + 1
                   
        'should find match and work
        Else
            'You might want to use multiple copies of the same text string.
            'In this case you need to call the bookmark as follows: "ARTextWhatever_01"
            'You can use as many bookmarks as you want.
            BkmTxtSplit = Split(BkmTxt(n), "_")
            vvalue = Range(BkmTxtSplit(0)).Text
            Set wdRng = wdApp.ActiveDocument.Bookmarks(BkmTxt(n)).Range
            If Len(sFormat) = 0 Then
            'replace the bookmark text
            wdRng.Text = vvalue
            
            Else
                'replace the bookmark text with formatted text
                wdRng.Text = Format(vvalue, sFormat)
            End If
            
            'Re-add the Bookmark
             wdRng.Bookmarks.Add BkmTxt(n), wdRng
            On Error Resume Next
        End If
    Next
   
    'PASTE TABLES LOOP
    n = 0
    For Each temp In BkmTable
        n = n + 1
        p = p + 1
        
        Prompt = "Please wait. Carrying out operation " & p & " of roughly " & pcount & ""
        Application.StatusBar = Prompt
        
        ' should find match and work
        If BkmTable(n) = Empty Then
            n = n + 1
        End If
        
        vntAnswer = Application.WorksheetFunction.Match(BkmTable(n), BkmNames, 0)
        If vntAnswer = n Then
            'Copy the required table
            Range(BkmTable(n)).Copy
            'Go to the where the table should be pasted
            wdApp.Selection.Goto What:=wdGoToBookmark, Name:=BkmTable(n)
            wdApp.Selection.Delete
            On Error Resume Next
            'Delete the current bookmark just in case
            wdApp.ActiveDocument.Bookmarks(BkmTable(n)).Delete
            On Error GoTo 0
            
            'Add temporary bookmark one in front of the table
            wdApp.Selection.Move Unit:=wdCharacter, Count:=0
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp1"




            'Paste the table
            wdApp.Selection.PasteAndFormat (wdPasteDefault)
            'Add temporary bookmark 2 and include a space (char32) - this is a bodge fix
            wdApp.Selection.TypeText Text:=Chr(32)
            'Dead Code wdApp.Selection.Move Unit:=wdCharacter, Count:=1
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp2"
            'Add another space for good luck
            wdApp.Selection.TypeText Text:=Chr(32)
            
            'Select the area encapsulated by the two temorary bookmarks
            wdApp.ActiveDocument.Range( _
                wdApp.ActiveDocument.Bookmarks("BkmTmp1").Range.Start, _
                wdApp.ActiveDocument.Bookmarks("BkmTmp2").Range.Start) _
                .Select
                
            'Make sure that the line spacing is not double (it normally is)
            wdApp.WordBasic.OpenOrCloseParaBelow
            
            'Centre the table
            wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
            
            'Add the original bookmark again
            wdApp.ActiveDocument.Bookmarks.Add BkmTable(n)
            
            'Delete the temporary bookmarks so that they can be re-used
            wdApp.ActiveDocument.Bookmarks("Bkmtmp1").Delete
            wdApp.ActiveDocument.Bookmarks("Bkmtmp2").Delete
            On Error Resume Next
        End If
    Next
    
    'PASTE CHART LOOP
    n = 0
    For Each temp In BkmChart
        n = n + 1
        p = p + 1
        
        Prompt = "Please wait. Carrying out operation " & p & " of roughly " & pcount & ""
        Application.StatusBar = Prompt
        
        ' should find match and work
        If BkmChart(n) = Empty Then
            n = n + 1
        End If
        
        BkmChartSplit = Split(BkmChart(n), "_")
        
        vntAnswer = Application.WorksheetFunction.Match(BkmChart(n), BkmNames, 0)
        If vntAnswer = n Then
            'Copy the required table
            ThisWorkbook.Sheets("Charts").ChartObjects(BkmChartSplit(0)).Copy
            'ThisWorkbook.Sheets(Charts).ChartObjects(BkmChartSplit(0)).Activate
            
            'ThisWorkbook.Sheets(Charts).ChartObjects(BkmChartSplit(0)).ChartArea.Copy
            'ChartObjects(BkmChart(n)).Copy




            'Go to the where the table should be pasted
            wdApp.Selection.Goto What:=wdGoToBookmark, Name:=BkmChart(n)
            wdApp.Selection.Delete
            On Error Resume Next
            'Delete the current bookmark just in case
            wdApp.ActiveDocument.Bookmarks(BkmChart(n)).Delete
            On Error GoTo 0
            
            'Add temporary bookmark one in front of the table
            wdApp.Selection.Move Unit:=wdCharacter, Count:=0
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp1"




            'Paste the table
            wdApp.Selection.PasteAndFormat (wdPasteDefault)
            'Add temporary bookmark 2 and include a space (char32) - this is a bodge fix
            wdApp.Selection.TypeText Text:=Chr(32)
            'Dead Code wdApp.Selection.Move Unit:=wdCharacter, Count:=1
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp2"
            'Add another space for good luck
            wdApp.Selection.TypeText Text:=Chr(32)
            
            'Select the area encapsulated by the two temorary bookmarks
            wdApp.ActiveDocument.Range( _
                wdApp.ActiveDocument.Bookmarks("BkmTmp1").Range.Start, _
                wdApp.ActiveDocument.Bookmarks("BkmTmp2").Range.Start) _
                .Select
                
            'Make sure that the line spacing is not double (it normally is)
            'wdApp.WordBasic.OpenOrCloseParaBelow
            
            'Centre the table
            'wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
            
            'Add the original bookmark again
            wdApp.ActiveDocument.Bookmarks.Add BkmChart(n)
            
            'Delete the temporary bookmarks so that they can be re-used
            wdApp.ActiveDocument.Bookmarks("Bkmtmp1").Delete
            wdApp.ActiveDocument.Bookmarks("Bkmtmp2").Delete
            On Error Resume Next
        End If
    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."
    Title = "Procedure Completion"
    MsgBox Prompt, vbOKOnly + vbInformation, Title
    
    'Make our Word session visible
    wdApp.Visible = True
    
    'Clean up
    Set wdApp = Nothing
    Set wdDoc = Nothing
    End With




ErrorExit:
    Set wdApp = Nothing
    Exit Sub
    
    'Error Handling routine
ErrorHandler:
    If Err.Number = 5174 Then
    MsgBox "Please check the file name you specified is correct."
        Resume Next
        
    'If Err.Number = 4198 Then
    'MsgBox "There is probably some data missing on the details page. Please check."
    'End If
        
    Else
        MsgBox "Error No: " & Err.Number & "; There is a problem"
        If Not wdApp Is Nothing Then
            wdApp.Quit False
        End If
        Resume ErrorExit
    End If
End Sub

Display More

It's bloody horrible, but it works very well. Any questions give me a shout!

RichardW · Aug 23rd 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Well done, when I have a chance I will play with it and comment. Does this make you the Geek of your department!

ZappAstrim · Aug 23rd 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Just noticed that there is a small error in the code:
wdApp.WordBasic.OpenOrCloseParaBelow

needs to be:

wdApp.WordBasic.CloseParaBelow

And yes, it totally makes me the geek of my department. But they love me for it, as what used to take half an hour of BORING copy + paste jobs now can be done in 30 seconds. Reports can be generated really quickly with less errors

Mr. Plow · Aug 23rd 2011

Re: Excel VBA to cycle through Word bookmarks and insert Excel range value

[EDIT - moved from other thread]
I know this discussion has jumped over to another thread so I'm going to link them together here: http://www.ozgrid.com/forum/showthread.php?t=157163&page=1.

I have pulled all this code from many sources and can take personal credit for very little of it.

The PopulateWordBookmarks sub has been improved to separate out bookmarks that are text and those that are charts/graphs. I've done this by beginning the names of my excel ranges that I want to be pictures with "chart". The process takes all the ranges beginning with "chart" and saves as a temporary .gif, then attempts to import that .gif file INTO the bookmark. Currently struggling with INTO and not AT.

Here is relevant code (suppressing some of the duplicative stuff previously posted):

Code

Sub PopulateWordBookmarks(strDoc As String)....
     For tmp2 = 1 To .Bookmarks.Count
....        
        If Left(strName, Minn(5, Len(strName))) = "chart" Then
        '   Save chart as GIF
            Set CurrentChart = ThisWorkbook.Charts(strName)        'want charts to be in separate tabs in spreadsheet
            Fname = ThisWorkbook.Path & Application.PathSeparator & strName & ".gif"
            CurrentChart.Export Filename:=Fname, filtername:="GIF"
            FillBookmarkImage wdDoc, strName, Fname     'HAVING PROBLEM WITH THIS FUNCTION        
        Else
            FillBookmark wdDoc, strValue, strName    'sbkmk(tmp2)
            strName = ""
        End If
    Next


End Sub

Display More

The FillBookmark sub used for any ranges that do not begin with "chart" remains unchanged.

The FillBookmarkImage sub is trying to delete all prior images and text from a bookmark, then replace with the new image. Right now it's inserting pictures AFTER the bookmark:

Code

Sub FillBookmarkImage(wdDoc As Object, strBMname As String, strImage As String)
    
    Dim j As Integer, loopvar As Integer
    Dim rangeBM As Word.Range
    
    With wdDoc
        Set rangeBM = .Bookmarks(strBMname).Range
        j = rangeBM.InlineShapes.Count
        For loopvar = 1 To j
            rangeBM.InlineShapes(loopvar).Delete
        Next
        rangeBM.Text = ""               'remove any text (also deletes bookmark)
        rangeBM.Bookmarks.Add strBMname        'recreate empty bookmark
        
        rangeBM.InlineShapes.AddPicture Filename:=strImage
        rangeBM.Select
        .Bookmarks.Add strBMname, Range:=Selection.Range
    End With
    
End Sub

Display More

Thanks for the help.

Mr. Plow · Aug 23rd 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

I didn't have any success with the code above. [EDIT - See above] I have posted some updated and additional code in the original thread here, http://www.ozgrid.com/forum/sh…48798&p=572856#post572856. I too am trying to get to the bottom of this issue. Main issue still left is removing existing images in a bookmark before inserting the new image INTO the bookmark (as opposed to AFTER the bookmark).

ZappAstrim · Aug 24th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Hi there Mr Plow. What issues are you having with the code? What version of Excel and Word are you running?

I will upload an example word and excel document when I get into the office for you to play around with that works on my end. I've tested the code in Office 2007. I've tried running it on my home computer (Office 2010) but there is a small problem with pasting charts.

ZappAstrim · Aug 24th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Please find attached example usage of the code.

Cheers.

ZappAstrim · Aug 24th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

I found some more errors in the code above. Please see the following downloads for some more slightly better code:
http://dl.dropbox.com/u/15735073/Permanent/Fruit.docx
http://dl.dropbox.com/u/15735073/Permanent/Fruit.xlsm

http://"http://dl.dropbox.com/u/15735073/Permanent/Fruit.xlsm"Edit: Just documented the hell out of the code. Same download.

I thought I would add the pretty much final code here, as the files might be removed at some point in time.

Code

Sub AutoReport()


'The purpose of this program is to remove a lot of tedious work around writing and if necessary updating
'reports. The program operates on the following principle:




'It will read all bookmarks from the word document specified and match them with named ranges in Excel with
'the same name. In the case of charts it will use the chart names.These bookmarks and named ranges require
'the following naming convention:




'For text items:    "ARTextXXX"
'For tables:        "ARTableYYY"
'For charts:        "ARChartZZZ"




'What the program does is load all the bookmarks into a list (also known as an array).
'Each bookmark will be assigned a number 'within the reange 1 to x (x is specified below).
'These bookarks are then filtered into three different 'categories using the above naming convention.
'This is necessary as a different operation has to be carried 'out for text, tables and charts.




'The program then works with the word document and jumps to the bookmarks location and deletes the current
'content. It then deletes the bookmark manually (as Word has an issue with inserting items into bookmarks
'and often deletes them itself). The program inserts the item and then re-instates the bookmark and moves
'on to the next item.




'To enable the same  item to be copied multiple times from excel the bookmarks in Word can use the
'following naming convention:
'ARTextChartorTable_01
'ARTextChartorTable_02
'etc.




Dim wdApp           As New Word.Application
Dim wdDoc           As Word.Document
Dim FilePath        As String
Dim FileName        As String
Dim n               As Long
Dim p               As Long
Dim pcount          As Long
Dim x               As Long
Dim Prompt          As String
Dim Title           As String
Dim StrDoc          As String
Dim BkmNo           As Long
Dim temp            As Variant
Dim MyRange         As Word.Range
Dim BkmTxtSplit     As Variant
Dim BkmChartSplit   As Variant
Dim BkmTableSplit   As Variant
Dim wdRng           As Object




'Things to make sure that the application runs properly and speeds things up.
With ThisWorkbook
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorHandler




    'Assign the Word file path and name to variables. This program looks for the file name in the named
    'range "AR_ReportName".
    Set wdApp = Nothing
    FilePath = ThisWorkbook.Path
    FileName = Range("AR_ReportName")
    StrDoc = FilePath & "\" & FileName
    'Opens the word document.
    Set wdDoc = wdApp.Documents.Open(StrDoc)
   
   'Populates array with bookmark names.
    With wdDoc
    ReDim BkmNames(1 To wdDoc.Bookmarks.Count)
        For BkmNo = 1 To wdDoc.Bookmarks.Count
            BkmNames(BkmNo) = wdDoc.Bookmarks(BkmNo).Name
        Next
    End With
    
    'If you want to see what Word is doing remove the comment charachter from the line below.
    'wdApp.Visible = True




    'Define x and pcount. X is the maximum number of bookmarks in the word document. pcount needs to be
    ' 3 times higher as it is used as  a status indicator and there are three different operations being
    'carried out cycling through all bookmarks each time.
    x = 100
    pcount = 300




    'creates an array with all the Bookmarks that are text based
    n = 0
    p = 1
    ReDim BkmTxt(1 To x)
    For Each temp In BkmNames
        n = n + 1
        If Left(BkmNames(n), 5) = "ARTex" Then
           BkmTxt(n) = BkmNames(n)
        End If
    Next
    
    'creates an array with all the Bookmarks that are table based
    n = 0
    ReDim BkmTable(1 To x)
    For Each temp In BkmNames
        n = n + 1
        If Left(BkmNames(n), 5) = "ARTab" Then
           BkmTable(n) = BkmNames(n)
        End If
    Next
    
    'creates an array with all the Bookmarks that are table based
    n = 0
    ReDim BkmChart(1 To x)
    For Each temp In BkmNames
        n = n + 1
        If Left(BkmNames(n), 5) = "ARCha" Then
           BkmChart(n) = BkmNames(n)
        End If
    Next
    
    
    'PASTE TEXT STRINGS LOOP
    n = 1
    For Each temp In BkmTxt
        p = p + 1
        Prompt = "Please wait. Copying text. Carrying out operation " & p & " of " & pcount & "."
        Application.StatusBar = Prompt
        
        'If The Bkmtxt(n) is empty then go to the next one, once that has been found do next operation.
        If BkmTxt(n) = Empty Then
            n = n + 1
                               
        'should find match and work
        Else
            
            'You might want to use multiple copies of the same text string.
            'In this case you need to call the bookmark as follows: "ARTextWhatever_01"
            'You can use as many bookmarks as you want.
            BkmTxtSplit = Split(BkmTxt(n), "_")
            vValue = Range(BkmTxtSplit(0)).Text




            Set wdRng = wdApp.ActiveDocument.Bookmarks(BkmTxt(n)).Range
            If Len(sFormat) = 0 Then
                'replace the bookmark text
                wdRng.Text = vValue
            Else
                'replace the bookmark text with formatted text
                wdRng.Text = Format(vValue, sFormat)
            End If
            
            'Re-add the Bookmark
             wdRng.Bookmarks.Add BkmTxt(n), wdRng
             n = n + 1
        End If
    Next
   
    'PASTE TABLES LOOP
    'This part of the program copies all the tables from the Excel sheets to the word document. It does so
    'by matching the bookmarks with the named ranges. There is also a rather complicated operation with two
    'temporary bookmarks. These need to be used, as Word deletes bookmarks when pasting into them. The way
    'it is done is as follows.
    'This program tells Word to go to the bookmark, delete the contents of the bookmark (cleaner that way)
    'and then deletes the bookmark iteself. It then inserts the first temporary bookmark. Then it pastes
    'the table into the document. It also centres the table and also removes double line spacing.
    'After that it adds a space " " and then inserts the second temporary bookmark and another space.
    'It then selects the area between the two bookmarks and adds the permanent bookmark again with the
    'same name. It then deletes the two temporary bookmarks so that they can be reused for the next loop.
    
    n = 1
    For Each temp In BkmTable
        p = p + 1
        
        Prompt = "Please wait. Copying tables. Carrying out operation " & p & " of " & pcount & "."
        Application.StatusBar = Prompt
        
        If BkmTable(n) = Empty Then
            n = n + 1
        Else
            'This removes the everything after the "_" in the bookmark so that the bookmark and the named
            'range can be matched up.
            BkmTableSplit = Split(BkmTable(n), "_")
            'Copy the required table
            Range(BkmTableSplit(0)).Copy
            'Go to the where the table should be pasted
            wdApp.Selection.Goto What:=wdGoToBookmark, Name:=BkmTable(n)
            'Delete the current bookmark and the current selection so that everything is nice and clean.
            wdApp.ActiveDocument.Bookmarks(BkmTable(n)).Delete
            wdApp.Selection.Delete
         
            'Add temporary bookmark one in front of the table
            wdApp.Selection.Move Unit:=wdCharacter, Count:=0
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp1"




            'Paste the table
            wdApp.Selection.PasteAndFormat (wdPasteDefault)
            'Add temporary bookmark 2 and include a space (char32) - this is a bodge fix
            wdApp.Selection.TypeText Text:=Chr(32)
            'Dead Code wdApp.Selection.Move Unit:=wdCharacter, Count:=1
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp2"
            'Add another space for good luck
            wdApp.Selection.TypeText Text:=Chr(32)
            
            'Select the area encapsulated by the two temorary bookmarks
            wdApp.ActiveDocument.Range( _
                wdApp.ActiveDocument.Bookmarks("BkmTmp1").Range.Start, _
                wdApp.ActiveDocument.Bookmarks("BkmTmp2").Range.Start) _
                .Select
   
            'Centre the table
            wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
            
            'Make sure that the line spacing is not double (it normally is)
            wdApp.WordBasic.CloseParaBelow
            
            'Add the original bookmark again
            wdApp.ActiveDocument.Bookmarks.Add BkmTable(n)
            
            'Delete the temporary bookmarks so that they can be re-used
            wdApp.ActiveDocument.Bookmarks("Bkmtmp1").Delete
            wdApp.ActiveDocument.Bookmarks("Bkmtmp2").Delete
            'Add 1 to n so that the program goes to the next value.
            n = n + 1
            'Empty the clipboard
            Application.CutCopyMode = False
        End If
    Next
    
    'PASTE CHART LOOP
    'This part of the application copies all the charts in the Excel document and pastes them into the
    'word document. It uses the same methodology for keeping the bookmarks as the tables part of the program.
    'Please ensure that you define what sheet you are copying your tables from (see below).
    
    'Reset n to 1
    n = 1
    For Each temp In BkmChart
        'Status indicator
        p = p + 1
        Prompt = "Please wait. Copying charts. Carrying out operation " & p & " of " & pcount & "."
        Application.StatusBar = Prompt
        
        'If BkmChart is empty see if the next one isn't
        If BkmChart(n) = Empty Then
            n = n + 1
        
        'If there is something in BkmChart carry out the following operation
        Else
            BkmChartSplit = Split(BkmChart(n), "_")
        
            'Copy the required table. IMPORTANT: You have to define what sheet your chart is to be
            'copied from. All charts must be in the same sheet.
            ThisWorkbook.Sheets("Charts").ChartObjects(BkmChartSplit(0)).Copy




            'Go to the where the table should be pasted
            wdApp.Selection.Goto What:=wdGoToBookmark, Name:=BkmChart(n)
            
            'Delete the current bookmark and the current selection so that everything is nice and clean.
            wdApp.ActiveDocument.Bookmarks(BkmChart(n)).Delete
            wdApp.Selection.Delete
                        
            'Add temporary bookmark one in front of the table
            wdApp.Selection.Move Unit:=wdCharacter, Count:=0
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp1"




            'Paste the table
            wdApp.Selection.PasteAndFormat (wdPasteDefault)
            'Add temporary bookmark 2 and include a space (char32) - this is a bodge fix
            wdApp.Selection.TypeText Text:=Chr(32)
            'Dead Code wdApp.Selection.Move Unit:=wdCharacter, Count:=1
            wdApp.ActiveDocument.Bookmarks.Add "Bkmtmp2"
            'Add another space for good luck
            wdApp.Selection.TypeText Text:=Chr(32)
            
            'Select the area encapsulated by the two temorary bookmarks
            wdApp.ActiveDocument.Range( _
                wdApp.ActiveDocument.Bookmarks("BkmTmp1").Range.Start, _
                wdApp.ActiveDocument.Bookmarks("BkmTmp2").Range.Start) _
                .Select
                
            'Add the original bookmark again
            wdApp.ActiveDocument.Bookmarks.Add BkmChart(n)
            
            'Delete the temporary bookmarks so that they can be re-used
            wdApp.ActiveDocument.Bookmarks("Bkmtmp1").Delete
            wdApp.ActiveDocument.Bookmarks("Bkmtmp2").Delete
            
            'Add 1 to n so that the program goes to the next value.
            n = n + 1
            
            'Empty the clipboard
            Application.CutCopyMode = False
        End If
    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."
    Title = "Procedure Completion"
    MsgBox Prompt, vbOKOnly + vbInformation, Title
    
    'Make our Word session visible
    wdApp.Visible = True
    
    'Clean up
    Set wdApp = Nothing
    Set wdDoc = Nothing
End With




ErrorExit:
    Set wdApp = Nothing
    Exit Sub
    
'Error Handling routine
ErrorHandler:
    If Err.Number = 5174 Then
    MsgBox "Please check the file name you specified is correct."
    Resume ErrorExit
    
    Else
        MsgBox "Error No: " & Err.Number & "; There is a problem"
        If Not wdApp Is Nothing Then
            wdApp.Quit False
        End If
        Resume ErrorExit
    End If
End Sub

Display More

Mr. Plow · Aug 25th 2011

Re: Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & table

Running Excel 2007 and Word 2007. An Office 2010 upgrade is probably not too far off in the future so hopefully final code will be usable in both versions.

I'm trying to import images into the bookmark, not charts. The reason is because I'm using my excel file for projections and other purposes after creating the Word reports. This will make the linked charts in Word change which I don't want. By first saving the Excel chart as a picture and then importing the picture into the bookmark, I don't have to worry about my Word report changing when my spreadsheet later does.

Excel VBA to cycle through Word bookmarks and insert ranges (text, graphs & tables)

Participate now!

Share