Pasting an Excel range of data into a word document but after a logo and Title

[lucky245]

I have searched around but I am finding it hard to actually get a solution. I have a word doc (currently leaving as a docx rather than dotx) with a logo and some text at the beginning.

I have set a bookmark "startingPoint" after these and was hoping to then paste in the data copied from excel into the word document at / or after the bookmark. I found some code for bookmarks but cant seem to get it to work for me. It just moves everything down and pastes above it.

Any clues as to why? please

Bookmark code:
Sub UpdateBookmark(BookmarkToUpdate As String, PasteRange As Variant)
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
BMRange = PasteRange
ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub


Code that I'm currently using to copy and paste.

Sub CopyExcelRngToWord() ' copies a range of data from Excel to a Word template
Dim xltblRange As Excel.Range
Dim ObjW As Word.Application
Dim ObjDoc As Word.Document
Dim ObjWTble As Word.Table
Dim templatename As String

templatename = ActiveWorkbook.Path & Application.PathSeparator & "Lab Template.docx"

Set xltblRange = ThisWorkbook.Worksheets("UIC").Range("$A$2:$J$24") ' fixed worksheet name and range for testing

On Error Resume Next
Set ObjW = GetObject(class:="Word.Application")
If ObjW Is Nothing Then Set ObjW = CreateObject(class:="Word.Application")

ObjW.Visible = True
ObjW.Activate

Set ObjD = ObjW.Documents.Open(templatename)
ObjD.PageSetup.Orientation = 1 'wdOrientLandscape

xltblRange .Copy

UpdateBookmark "StartingPoint", xltblRange ' not using as doesn't work

ObjD..Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

Set ObjWTble = WordDoc.Tables(1)
ObjWTble.AutoFitBehavior (wdAutoFitWindow)

ObjD.SaveAs ActiveWorkbook.Path & Application.PathSeparator & "Final_Report11.docx" 'fixed doc name for testing
ObjD.Close

End Sub

 

[NdNoviceHlp]

Hi lucky245. Not real clear what you're trying to do. Paste an XL table (twice?) to a Word bookmark. If you want to use the "UpdateBookmark" sub you will need to remove this line of code from your "CopyExcelRngToWord" sub and place it at the top of your code module....

Dim ObjDoc As Word.Document

The "UpdateBookmark" sub....

Sub UpdateBookmark(BookmarkToUpdate As String)
Dim ORng As Object
With ObjDoc
  'make sure bookmark exists
  If .Bookmarks(BookmarkToUpdate).Exists Then
    Set ORng = .Bookmarks(BookmarkToUpdate).Range
    ORng.Delete
    ORng.Paste
    .Bookmarks.Add BookmarkToUpdate, ORng
  Application.CutCopyMode = False
  Set ORng = Nothing
End If
End With
End Sub

To operate using your StartingPoint bookmark...

Call UpdateBookmark("StartingPoint")

You can also paste an XL table at a bookmark...

'Copy Table Range from Excel
Set tbl = ThisWorkbook.Worksheets(1).ListObjects(1).Range
tbl.Copy
'Paste Table into MS Word using inserted Bookmark
With ObjDoc
If .Bookmarks("StartingPoint").Exists Then
.Bookmarks("StartingPoint").Range.PasteExcelTable _
  LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Application.CutCopyMode = False
End If
End With

Untested code but looks OK. HTH. Dave
ps. Please use code tags

 

[lucky245]

Thank you for this and I apologise for not leaving in comments, so I've moved the ObjD to the top of the module but I keep getting a method error as it enters the updateBookmark sub. Also not sure I understood the why am I trying to paste XL twice comment. Maybe too early in the morning on my part.

Dim ObjD As Word.Document

Sub UpdateBookmark(BookmarkToUpdate As String)
Dim ORng As Object
    With ObjD
      'make sure bookmark exists
        If .Bookmarks(BookmarkToUpdate).Exists Then
            Set ORng = .Bookmarks(BookmarkToUpdate).Range
            ORng.Delete
            ORng.Paste
            .Bookmarks.Add BookmarkToUpdate, ORng
            Application.CutCopyMode = False
            Set ORng = Nothing
        End If
    End With
End Sub

Sub CopyExcelRngToWord() ' copies a range of data from Excel to a Word template
Dim xltblRange As Excel.Range
Dim ObjW As Word.Application
Dim ObjWTble As Word.Table
Dim Templatename As String
Dim ORng As Object

    Templatename = ActiveWorkbook.Path & Application.PathSeparator & "Lab Template.docx"
  
    'The next line of code selects a specific range of cells and saves it to an Excel Range object in VBA.
    Set xltblRange = ThisWorkbook.Worksheets("UIC").Range("$A$2:$J$24") ' fixed worksheet name and range for testing
  
    'Check if Word application is already open. If Word isn’t already opened, then launch it using the CreateObject function.
    'The “On Error Resume Next” line prevents any error from the first GetObject function (if Word isn’t already open).
  
    On Error Resume Next
    Set ObjW = GetObject(class:="Word.Application")
  
    If ObjW Is Nothing Then Set ObjW = CreateObject(class:="Word.Application")
  
    'Now that Word is live, make it visible and activate it for use.
    ObjW.Visible = True
    ObjW.Activate
  
    'Next, you want to open the template inside the Word application.
    Set ObjD = ObjW.Documents.Open(Templatename)
    ObjD.PageSetup.Orientation = 1 'set page orientation to landscape
  
    'copy the range declared above
    xltblRange.Copy
  
    'this is the point at which I want the excel data to be pasted in the word document
    Call UpdateBookmark("Startingpoint")
  
    'Then paste the copied info
    ObjD.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
  
    'The switches in the above function insert a non-linked table using source Excel formatting (not Word formatting) and not using rich text format.
  
    'Finally, to deal with Excel ranges that are wider than the document, I need to autofit the new table, so it fits within the margins of my new Word document.
    Set ObjWTble = WordDoc.Tables(1)
    ObjWTble.AutoFitBehavior (wdAutoFitWindow)
     'saves to name I require
    ObjD.SaveAs ActiveWorkbook.Path & Application.PathSeparator & "Final_Report11.docx" 'fixed doc name for testing
    'closes document
    ObjD.Close
  
    Set ObjD = Nothing
    Set ObjWTble = Nothing
    Set ObjW = Nothing

End Sub

 

[lucky245]

Sorry ran out of time to edit above comment so posting it here

Not sure I understood the why am I trying to paste XL twice comment. Maybe too early in the morning on my part.

The aim of this code is after I have copied data (which happens to be labs tests) from other inputs (business objects) I must then cost each row using vba and a master price list in the parent workbook. The more items used the bigger the range and as the items have different associated costs this is all processed beforehand in the parent workbook from which I will be copying.

The part concerning this problem:
I need to then export (copy/paste) the updated data into a word document. This copied data must then be pasted into a word document which has both a logo and a line of information about the customer hence why I created a bookmark and am trying to paste after or on the bookmark.

Hope that makes my task clearer to understand.

 

[lucky245]

'So I modified the code (I found the double paste issue) and it seems to work now but every now and again I get the "462 error code remote server" error in the UpdateBookmark sub. Any ideas? its not always just now and again please.

Sub CopyExcelRngToWord1()

Dim ObjW As Word.Application
Dim ObjD As Word.Document
Dim xltblRange As Range
Dim Templatename, BookmarkToUpdate As String
Dim ObjWTable As Object

Templatename = ActiveWorkbook.Path & Application.PathSeparator & "Lab Template.docx"
Check_If_File_Exits_then_Delete "Final_Report11.docx"  ' check to see if the word doc exists already and if so deletes

On Error Resume Next
Set ObjW = GetObject(class:="Word.Application")
If ObjW Is Nothing Then Set ObjW = CreateObject(class:="Word.Application")
    
    ObjW.Visible = True
    ObjW.Activate
    
Set ObjD = ObjW.Documents.Open(Templatename)
ObjD.PageSetup.Orientation = 1 'wdOrientLandscape

Set xltblRange = ActiveSheet.Range("B2:J24") ' fixed worksheet name and range for testing

xltblRange.Copy

' pause the app
Application.Wait Now() + #12:00:02 AM# ' pause for 2 secs

Call UpdateBookmark("Startingpoint")

Set ObjWTable = ObjD.Tables(1)
    ObjWTable.AutoFitBehavior 2 ' wdAutoFitWindow:

ObjD.SaveAs ActiveWorkbook.Path & Application.PathSeparator & "Final_Report11.docx" 'fixed doc name for testing
ObjD.Close

Application.CutCopyMode = False

ObjW.Quit
Set ObjD = Nothing
Set ObjW = Nothing

End Sub
'

'

Sub UpdateBookmark(BookmarkToUpdate As String)
Dim ORng As Object

  'make sure bookmark exists
     If ActiveDocument.Bookmarks.Exists(BookmarkToUpdate) = True Then
          Set ORng = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
          ORng.Delete
          ORng.Paste
          ActiveDocument.Bookmarks.Add BookmarkToUpdate, ORng
          Application.CutCopyMode = False
     End If
Set ORng = Nothing
End Sub
'

 

[NdNoviceHlp]

Is the copied range an XL table? Not sure about the error but you may want to trial removing the "Application.Wait" line of code and insert this....

 UpdateBookmark("Startingpoint")
Dim t As Double
t = Timer
Do Until Timer - t > 1
DoEvents
Loop

If the copied range is a table it may be better to go with the PasteExcelTable code that I posted instead. Dave

 

[NdNoviceHlp]

I did a bit more googling about your error. Your task manger may be able to tell U what's going wrong. Check and see if there is more than 1 Word process running after the error. Sometimes after an error, U will need to go to the task manager and manually quit all Word processes (ie. Select the Word process and then select End Process). Also, it seems that it may be possible that U need to more fully qualify your variables. So...

Dim xltblRange As Excel.Range

You should also declare....

Dim Templatename as String

HTH. Dave

 

[lucky245]

Something is just not right, roughly 60% of the time it works and then the updatebookmark sub doesn't see the bookmark so nothing gets copied. I'm obviously missing something fundemental thats stopping it working as far as I can see I'm referencing all my variables

Dim ObjD As Word.Document



Sub CopyExcelRngToWord() ' copies a range of data from Excel to a Word template
Dim xltblRange As Excel.Range
Dim Templatename As String
Dim ObjW As Word.Application
Dim ObjWTble As Word.Table


    'Word Template will always be in same folder as output and input files
    Templatename = ActiveWorkbook.Path & Application.PathSeparator & "Lab Template.docx" ' This has a logo and txt at beginning hence need for bookmark.  Bookmark "SP" is already set
    
    Check_If_File_Exits_then_Delete "Final_Report11.docx" 'fixed name for testing purposes so checks if exists and deletes if it is
  
  

  
    'Check if Word application is already open. If Word isn’t already opened, then launch it using the CreateObject function.
    'The “On Error Resume Next” line prevents any error from the first GetObject function (if Word isn’t already open).
  
    On Error Resume Next
    Set ObjW = GetObject(class:="Word.Application")
  
    If ObjW Is Nothing Then Set ObjW = CreateObject(class:="Word.Application")
  
    'Now that Word is live, make it visible and activate it for use.
    ObjW.Visible = True
    ObjW.Activate
  
    'Next, you want to open the template "Lab Template.docx" inside the Word application.
    Set ObjD = ObjW.Documents.Open(Templatename)
    ObjD.PageSetup.Orientation = 1 'set page orientation to landscape

    'The next line of code selects a specific range of cells and saves it to an Excel Range object in VBA.
        Set xltblRange = ThisWorkbook.Worksheets("UIC").Range("$A$2:$J$24") ' fixed worksheet name and range for testing
  
    'copy the range declared above from the excel worksheet
    xltblRange.Copy


    'this is the point at which I want the excel data to be pasted in the word document
   UpdateBookmark ("Startingpoint")

  
    'Finally, to deal with Excel ranges that are wider than the document, I need to autofit the new table, so it fits within the margins of my new Word document.
    Set ObjWTble = WordDoc.Tables(1)
    ObjWTble.AutoFitBehavior (wdAutoFitWindow)
     'saves to name I require
    ObjD.SaveAs ActiveWorkbook.Path & Application.PathSeparator & "Final_Report11.docx" 'fixed doc name for testing
    'closes document
    ObjD.Close
    ObjW.Quit
  
    Set ObjD = Nothing
    Set ObjWTble = Nothing
    Set ObjW = Nothing

End Sub

Sub UpdateBookmark(BookmarkToUpdate As String)  'its in here the code seems to sometimes fail to always find the bookmark even though its there as stated sees it 60% of the time, I have changed the code slightly to see if it solved the issue but no still same problem not always seeing the bookmark

Dim ORng As Object

        If ActiveDocument.Bookmarks.Exists(BookmarkToUpdate) Then
            Set ORng = ObjD.Bookmarks(BookmarkToUpdate).Range
            ORng.Paste
            Application.CutCopyMode = False
        End If

Set ORng = Nothing
End Sub


'************ original version below which had same issue
Sub UpdateBookmark(BookmarkToUpdate As String)' old version
Dim ORng As Object

  'make sure bookmark exists
     If ActiveDocument.Bookmarks.Exists(BookmarkToUpdate) = True Then
          Set ORng = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
          ORng.Delete
          ORng.Paste
          ActiveDocument.Bookmarks.Add BookmarkToUpdate, ORng
          Application.CutCopyMode = False
     End If
Set ORng = Nothing
End Sub

 

[lucky245]

Problem solved. Thank you for assistance from NdNoviceHlpand another genius CheeseSandwich (to me anyway I get to keep what's left of my hair)

Dim ObjW As Word.Application ' moved this out of CopyExcelRngToWord
Dim ObjD As Word.Document 



Sub CopyExcelRngToWord()
    Dim xltblRange As Excel.Range
    Dim Templatename As String
    Dim ObjWTble As Word.Table

    Templatename = ActiveWorkbook.Path & Application.PathSeparator & "Lab Template.docx" ' This has a logo and txt at beginning hence need for bookmark.  Bookmark "SP" is already set
    Set xltblRange = ThisWorkbook.Worksheets("UIC").Range("$A$2:$J$24") ' fixed worksheet name and range for testing
    On Error Resume Next
    Set ObjW = GetObject(class:="Word.Application")
    If ObjW Is Nothing Then Set ObjW = CreateObject(class:="Word.Application")
    ObjW.Visible = True
    Set ObjD = ObjW.Documents.Open(Templatename)
    ObjD.PageSetup.Orientation = 1 'set page orientation to landscape
    xltblRange.Copy
    UpdateBookmark ("SP")
    Set ObjWTble = WordDoc.Tables(1)
    ObjWTble.AutoFitBehavior (wdAutoFitWindow)
    ObjD.SaveAs ActiveWorkbook.Path & Application.PathSeparator & "Final_Report11.docx" 'fixed doc name for testing
    ObjD.Close
    ObjW.Quit
  
    Set ObjD = Nothing
    Set ObjWTble = Nothing
    Set ObjW = Nothing

End Sub


Sub UpdateBookmark(BookmarkToUpdate As String) 'its in here the code seems to sometimes fail to always find the bookmark even though its there
    Dim ORng As Object

    If ObjD.Bookmarks.Exists(BookmarkToUpdate) Then
        Set ORng = ObjD.Bookmarks(BookmarkToUpdate).Range
        ORng.Paste
        Application.CutCopyMode = False

    End If
    Set ORng = Nothing
End Sub

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. I'm not sure why you don't have to first delete the bookmark then paste and then replace the bookmark? Maybe just moving the ObjW declaration was needed? You could move the Set ORng = Nothing code to before the End If as the ORng is not previously set to anything unless the bookmark exists. Hmmm.... CheeseSandwich doesn't seem to be a MrExcel member? Anyways, have a nice day. Dave