Search code examples
vbaexcelms-wordbookmarks

Copy and paste INCLUDING bookmarks VBA


I have an Excel worksheet from which I am trying to paste Information into a wordfile "Template" (just a word-document in the layout I want), which contains bookmarks. What I would like to do is:

  1. Copy everything in the word document (including bookmarks)
  2. Replace the bookmarks with the data in my sheet
  3. Go to the bottom of the page, insert a page break and paste the copied Text, including bookmarks
  4. Loop through points 2 & 3 for all the rows in my excel file

I have patched together some code, but I'm unable to get the bookmark to paste the text with the bookmarks still intact. Can any of you help me get there?

Sub ReplaceBookmarks

'Select template
PickFolder = "C:\Users\Folder"   
Set fdn = Application.FileDialog(msoFileDialogFilePicker)
With fdn
    .AllowMultiSelect = False
    .Title = "Please select the file containing the Template"
    .Filters.Clear
    .InitialFileName = PickFolder
    If .Show = True Then
    Temp = fdn.SelectedItems(1)
    End If
End With

'open the word document
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Open(Temp)
'show the word document - put outside of loop for speed later
wdApp.Visible = True

'Copy everything in word document    
    wdDoc.Application.Selection.Wholestory
    wdDoc.Application.Selection.Copy

LastRow2 = 110    ' In real code this is counted on the sheet
For i = 2 To LastRow2      
'Data that will replace bookmarks in ws2 (defined somewhere in real code)
    Rf1 = ws2.Cells(i, 4).Value
    Rf2 = ws2.Cells(i, 2).Value
    Rf3 = ws2.Cells(i, 3).Value

'replace the bookmarks with the variables - references sub "Fillbookmark"
FillBookmark wdDoc, Rf1, "Rf1"
FillBookmark wdDoc, Rf2, "Rf2"
FillBookmark wdDoc, Rf3, "Rf3"

' Jump to bottom of document, add page break and paste
With wdDoc
.Application.Selection.EndKey Unit:=wdStory
.Application.Selection.InsertBreak Type:=wdPageBreak
.Application.Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With
Next i
End Sub

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 
End Sub

Solution

  • First try, instead of Copy/Paste, using WordOpenXml. This is much more reliable than copy/paste. Now remember that a Bookmark is a named location, when you copy a section of the document and put it back on another location when the original bookmark is still in place, the new section won't get the copied Bookmark.

    I'll provide a little bit of code to show this to you:

    Sub Test()
    
       ActiveDocument.Bookmarks.Add Name:="BM1", Range:=ActiveDocument.Paragraphs(1).Range
    
       ActiveDocument.Application.Selection.WholeStory
    
       Dim openxml As String
       openxml = ActiveDocument.Application.Selection.wordopenxml
    
       ActiveDocument.Bookmarks(1).Delete
    
       With ActiveDocument
          .Application.Selection.EndKey Unit:=wdStory
          .Application.Selection.InsertBreak Type:=wdPageBreak
          .Application.Selection.InsertXML xml:=openxml
       End With
    
    '      ActiveDocument.Bookmarks(1).Delete
    
       With ActiveDocument
          .Application.Selection.EndKey Unit:=wdStory
          .Application.Selection.InsertBreak Type:=wdPageBreak
          .Application.Selection.InsertXML xml:=openxml
       End With
    End Sub
    

    Now open a new document enter some text by entering =Rand() as text in the document and hit enter Next run the code from the Test macro.

    You'll see that because you delete the bookmark using ActiveDocument.Bookmarks(1).Delete from the original part the first inserted text now contains the bookmark, the second does not.

    If you uncomment the ' ActiveDocument.Bookmarks(1).Delete line you will see that the bookmark ends up in the second added text part because there is no duplicate bookmark anymore when creating the second section.

    So in short, copying a bookmark will not duplicate the bookmark when pasting it, so you need to make sure you either delete the original bookmark or rename the bookmarks to make them unique again. Duplicates is a no go.