将 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
我在 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