Блог

Я использую Office 365 на 64-разрядном ПК с Windows 10.

У меня есть документ Word с таблицей, в которую я хочу скопировать элементы из документа Excel. Элементами являются: а) текст из его ячейки, б) гиперссылка из его ячейки и в) изображения из списка изображений.

Первые две задачи успешно выполняются следующим подразделом:

 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:MyPathMyExcelDoc.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 я могу выбрать нужное изображение по его индексу, используя первые две активные строки следующего подраздела:

 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 " amp; 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 с использованием последних шести строк.
Но я не выяснил, как скопировать изображение, которое я выбрал в документе Excel, в буфер обмена с помощью макроса Word.

Можно ли это как-то сделать?

Можно ли выполнить копирование гиперссылки более разумным способом?

Попробуйте

 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 " amp; 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