Copy range from Excel Spreadsheet and paste into saved Word Document as picture

[chrisellis250]

Hello,

My current code below, copies data in a specific cell to a bookmark in a saved Word Document. Is there a way I could edit my code to past a Range (i.e. B2:G23) to the bookmark in the word document as a picture?

Private Sub CommandButton5_Click()

Dim objWord As Object
Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Word Data")

    Set objWord = CreateObject("Word.Application")

    objWord.Visible = True

    objWord.documents.Open "C:\Users\Christopher.Ellis\Desktop\CPA Test\CE1.docx" ' change as required

    With objWord.ActiveDocument
        .bookmarks("ContactWOP1").Range.Text = ws.Range("B2").Value
        .bookmarks("CE1").Range.Text = ws.Range("J25").Value
    
    End With
 
    Set objWord = Nothing


End Sub

Any help much appreciated

[Greg M]

Hi there,

See if the following code does what you need:

Option Explicit


Private Sub CommandButton5_Click()

'   Excel parameters
    Const sRANGE_TO_COPY    As String = "B2:G23"
    Const sSHEET_NAME       As String = "Word Data"

'   Word parameters
    Const sBOOKMARK_NAME    As String = "ContactWOP1"
    Const sTARGET_PATH      As String = "H:\"
    Const sTARGET_NAME      As String = "Doc1.docx"

    Dim objWord             As Object
    Dim wks                 As Worksheet

    Set wks = ThisWorkbook.Sheets(sSHEET_NAME)

        wks.Range(sRANGE_TO_COPY).CopyPicture

    Set objWord = CreateObject("Word.Application")

        objWord.Visible = True

        objWord.documents.Open sTARGET_PATH & sTARGET_NAME

        objWord.ActiveDocument.Bookmarks(sBOOKMARK_NAME).Range.Paste
 
    Set objWord = Nothing
    Set wks = Nothing

End Sub

The highlighted values may be edited to suit your requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M

[chrisellis250]

Hi Greg,

Many thanks for that - it works perfectly. Is there a way I could incorporate more ranges into the code, to paste other ranges of data as pictures to specific bookmarks in the document?

[chrisellis250]

Hi Greg,

Many thanks for that - it works perfectly. Is there a way I could incorporate more ranges into the code, to paste other ranges of data as pictures to specific bookmarks in the document?

[Greg M]

Hi again,

Thanks for your feedback. I think the following (untested) code should do what you need:

Option Explicit


Private Sub CommandButton5_Click()

'   Excel parameters
    Const sSHEET_NAME       As String = "Word Data"

'   Word parameters
    Const sTARGET_PATH      As String = "H:\"
    Const sTARGET_NAME      As String = "Doc1.docx"

    Dim sBookmarkName       As String
    Dim sRangeToCopy        As String
    Dim vaDataValues        As Variant
    Dim objWord             As Object
    Dim iRowNo              As Integer
    Dim wks                 As Worksheet

    ReDim vaDataValues(1 To 4, 1 To 2)

    vaDataValues(1, 1) = "A11:B19"
    vaDataValues(1, 2) = "Bookmark_1"
    vaDataValues(2, 1) = "G22:I35"
    vaDataValues(2, 2) = "Bookmark_2"
    vaDataValues(3, 1) = "M33:P47"
    vaDataValues(3, 2) = "Bookmark_3"
    vaDataValues(4, 1) = "T44:W57"
    vaDataValues(4, 2) = "Bookmark_4"

    Set objWord = CreateObject("Word.Application")

        objWord.Visible = True

        objWord.documents.Open sTARGET_PATH & sTARGET_NAME

    Set wks = ThisWorkbook.Sheets(sSHEET_NAME)

        For iRowNo = LBound(vaDataValues, 1) To UBound(vaDataValues, 1)

            sRangeToCopy = vaDataValues(iRowNo, 1)
            sBookmarkName = vaDataValues(iRowNo, 2)

            wks.Range(sRangeToCopy).CopyPicture

            objWord.ActiveDocument.Bookmarks(sBookmarkName).Range.Paste
 
        Next iRowNo
 
    Set objWord = Nothing
    Set wks = Nothing

End Sub

As before, the highlighted values may be changed to suit your requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M

[chrisellis250]

Thanks Greg, that is excellent. Much appreciated.

One final thought after testing, is there a way the code could be amended to copy a single cell, or a range to a bookmark in the same word document but where it is pasted as text, as opposed to picture.

So the code would paste some ranges as pictures and some as text?

[Greg M]

Hi again,

Many thanks for your feedback and also for the Reputation increase - much appreciated!

I think that something along the following lines should do what you need:

Option Explicit


Private Sub CommandButton5_Click()

'   Excel parameters
    Const sSHEET_NAME       As String = "Word Data"

'   Word parameters
    Const sTARGET_PATH      As String = "H:\"
    Const sTARGET_NAME      As String = "Doc1.docx"

    Dim bCopyAsPicture      As Boolean
    Dim sBookmarkName       As String
    Dim sRangeToCopy        As String
    Dim vaDataValues        As Variant
    Dim objWord             As Object
    Dim iRowNo              As Integer
    Dim wks                 As Worksheet

    ReDim vaDataValues(1 To 4, 1 To 3)

    vaDataValues(1, 1) = "A11"
    vaDataValues(1, 2) = "Bookmark_1"
    vaDataValues(1, 3) = False              '   Copy as Text
    vaDataValues(2, 1) = "G22:I35"
    vaDataValues(2, 2) = "Bookmark_2"
    vaDataValues(2, 3) = True               '   Copy as Picture
    vaDataValues(3, 1) = "K33:N35"
    vaDataValues(3, 2) = "Bookmark_3"
    vaDataValues(3, 3) = True               '   Copy as Picture
    vaDataValues(4, 1) = "S44"
    vaDataValues(4, 2) = "Bookmark_4"
    vaDataValues(4, 3) = False              '   Copy as Text

    Set objWord = CreateObject("Word.Application")

        objWord.Visible = True

        objWord.documents.Open sTARGET_PATH & sTARGET_NAME

    Set wks = ThisWorkbook.Sheets(sSHEET_NAME)

        For iRowNo = LBound(vaDataValues, 1) To UBound(vaDataValues, 1)

            sRangeToCopy = vaDataValues(iRowNo, 1)
            sBookmarkName = vaDataValues(iRowNo, 2)
            bCopyAsPicture = vaDataValues(iRowNo, 3)

            If bCopyAsPicture = True Then
                  wks.Range(sRangeToCopy).CopyPicture
            Else: wks.Range(sRangeToCopy).Copy
            End If

            objWord.ActiveDocument.Bookmarks(sBookmarkName).Range.Paste

        Next iRowNo

    Set objWord = Nothing
    Set wks = Nothing

End Sub

If you are likely to be dealing with a large number of ranges, it would probably be much easier to enter all of the Range / Bookmark Name / Copy Method information on a worksheet, and to pass all of that information to the above routine in the form of an array.

Hope this helps - as always, please let me know how you get on.

Best regards,

Greg M

[chrisellis250]

Hi Greg - one final thought. Is there a way to define the size of each picture?