将 Excel 文件中的图像复制到 Word table

Copying images in an Excel file into a Word table

我在 Windows 10 64 位电脑上使用 Office 365。

我有一个带有 table 的 Word 文档,我想将 Excel 文档中的元素复制到其中。这些元素是 a) 来自其单元格的文本,b) 来自其单元格的超链接和 c) 来自图像列表的图像。

前两个任务由以下子成功执行:

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

我通过读取地址和标题复制超链接,然后在 Word 中重新创建它。

我还可以从 Word select 使用以下子项的前两个活动行通过其索引给出图像:

Sub CopyImageFromExcelToWord(xlSheet As Excel.Worksheet, imgNo As Long, tbl As Word.Table)
    Dim strId As String
    ' Syntax at https://docs.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

可以使用最后六行将剪贴板中的图像插入到 Word 中。 但是我还没有找到如何使用 Word 宏将我 select 在 Excel 文档中编辑的图像复制到剪贴板。

这能以某种方式完成吗?

能否以更智能的方式执行超链接的复制?

尝试

Sub CopyImageFromExcelToWord(xlSheet As Excel.Worksheet, imgNo As Long, tbl As Word.Table)
    Dim strId As String
    ' Syntax at https://docs.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