Holger Nielsen
Holger Nielsen

Reputation: 63

Copying images in an Excel file into a Word table

I am using Office 365 on a Windows 10 64-bit pc.

I have a Word document with a table into which I want to copy elements from an Excel document. The elements are a) text from its cell, b) a hyperlink from its cell and c) images from a list of images.

The first two tasks are performed successfully by the following sub:

Sub ImportFromExcel()
    Dim RowNo As Long, RowTarget As Long
    Dim RowFirst As Long, RowLast As Long
    Dim strContent As String, strLink As String, strDisplay As String
    Dim xlAppl As New Excel.Application
    Dim xlBook As New Excel.Workbook
    Dim xlSheet As New Excel.Worksheet
    Dim ExcelFileName As String
    Dim tbl As Word.Table
    
    On Error GoTo Finish
    ExcelFileName = "C:\MyPath\MyExcelDoc.xlsm"
    Set xlAppl = CreateObject("Excel.Application")
    xlAppl.Application.Visible = False
    xlAppl.Workbooks.Open ExcelFileName
    Set xlBook = xlAppl.ActiveWorkbook
    Set xlSheet = xlBook.Worksheets("Titan")
    Set tbl = ActiveDocument.Tables(1)

    RowFirst = 6: RowLast = 19
    For RowNo = RowFirst To RowLast
        RowTarget = RowNo - RowFirst + 1
        strContent = xlSheet.Cells(RowNo, 5).Value
        tbl.Cell(RowTarget, 1).Range.Text = strContent
        strDisplay = xlSheet.Cells(RowNo, 3).Value
        tbl.Cell(RowTarget, 3).Range.Text = strContent
        strLink = xlSheet.Cells(RowNo, 3).Hyperlinks(1).Address
        InsertHyperlinkInTable tbl, RowTarget, 3, strLink, strDisplay
        '  CopyImageFromExcelToWord xlSheet, RowTarget, tbl
    Next RowNo
Finish:
    xlAppl.ActiveWorkbook.Close False ' Word will not freeze at this point
    xlAppl.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlAppl = Nothing
End Sub

I copy the hyperlink by reading its address and caption and then recreating it in Word.

Also from Word I can select a give image by way of its index using the first two active lines of the following sub:

Sub CopyImageFromExcelToWord(xlSheet As Excel.Worksheet, imgNo As Long, tbl As Word.Table)
    Dim strId As String
    ' Syntax at https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.select
    strId = "Picture " & CStr(2 * imgNo)
    xlSheet.Shapes.Range(Array(strId)).Select
    
'    Missing link !

    With tbl.Cell(1, 4)
        .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        .VerticalAlignment = wdCellAlignVerticalCenter
        .Select
    End With
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub

An image residing in the clipboard can be inserted into Word using the last six lines. But I have not found out how to copy the image I selected in the Excel document to the clipboard with a Word macro.

Can this be done somehow?

Can the copying of the hyperlink be performed in a smarter way?

Upvotes: 0

Views: 133

Answers (1)

Timothy Rylatt
Timothy Rylatt

Reputation: 7850

Try

Sub CopyImageFromExcelToWord(xlSheet As Excel.Worksheet, imgNo As Long, tbl As Word.Table)
    Dim strId As String
    ' Syntax at https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.select
    strId = "Picture " & CStr(2 * imgNo)
    xlSheet.Shapes.Range(Array(strId)).Item(1).Copy
    
    With tbl.Cell(1, 4)
        .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        .VerticalAlignment = wdCellAlignVerticalCenter
        .Range.PasteAndFormat wdFormatOriginalFormatting
    End With
End Sub

Upvotes: 2

Related Questions