vba - 如何将嵌入图片从 Excel 保存/复制到 Word

Question

我拥有的:一个 Excel 文件，其中的列(实际上是自由格式，但在列内对齐)中的一些元素嵌入了 bmp 图片，显示公式 =EMBED("Paint.Picture","")当你点击它们时。当您查看 Excel 工作表时，仅显示代表图片的图标，而不显示图片本身。

我想要什么:将嵌入的图片(不是图标)复制到新的 Word 文档。

我迄今为止的代码:

'Image Objects
Dim myObjs As Shapes
Dim myObj As Shape
Set myObjs = ActiveSheet.Shapes

'Traversing objects
Dim row As Integer
Dim myRange As Range
Dim myRange2 As Range
Dim isAddressMatch As Boolean

'Word Document Objects
Dim wordApp As New Word.Application
Dim myWord As Word.Document


'Prepare word for output
Set myWord = wordApp.Documents.Add
wordApp.Visible = True

'Initalize traversing objectts
Set myRange = Sheets("myWorksheet").Range("Q5")
Set myRange2 = Sheets("myWorksheet").Range("E5")
row = 0

'Loop through range values in the desired column
While (myRange2.Offset(row).Value <> "")
    'Loop through all shape objects until address match is found.
    For Each myObj In myObjs

        On Error Resume Next
        isAddressMatch = (myObj.TopLeftCell.Address = myRange.Offset(row).Address)
        If Err.Number <> 0 Then
            isAddressMatch = False
            On Error GoTo 0
        End If

        'When match is found copy the bmp picture from Excel to Word
        If (isAddressMatch) Then
            myObj.Select
            ''''''''This copies the excel default picture,'''''''''''''''
            ''''''''not the picture that is embeded.'''''''''''''''''''''
            myObj.CopyPicture 'What is the correct way to copy myObj

            myWord.Range.Paste
            'Rest of the code not yet implement

        End If
    Next
    row = row + 1
Wend

运行代码时会发生什么:我的代码遍历列边界内的所有“形状”并复制该对象图片。但是，当我将其粘贴到Word中时，它实际上复制了链接图像(图标)，而不是底层嵌入图像。

到目前为止我发现了什么: This code它向我展示了如何创建嵌入对象，但不展示如何复制对象。

Answer 1

更新:更简单的解决方案

正如 jspek 的注释中所指出的，实际上可以使用 OLEObject 的 Copy 方法来复制图像，例如:

Dim obj As OLEObject
Set obj = ActiveSheet.OLEObjects(myObj.Name)

'Copy the OLE object representing a picture.
obj.Copy
'Paste the picture in Word.
myWord.Range.Paste

旧解决方案

我发现了一个涉及剪贴板和 SendKeys 的次优解决方案 - 灵感来自 this link 。我确信您可以通过探索提取 OLEObject 属性的方法来更优雅地完成此操作。在撰写本文时，提取这些内容超出了我的专业范围:-)

它围绕OLEObject。此代码执行 OLE object's host application (在本例中为 Paint)您的图片，发送按键来复制图片，最后将其粘贴到 Word 中。

'Get the OLE object matching the shape name.
Dim obj As OLEObject
Set obj = ActiveSheet.OLEObjects(myObj.Name)

'Activate the OLE host application.
obj.Activate
'Send CTRL+A to select the picture in Paint and CTRL+C to copy it.
Application.SendKeys "^a"
Application.SendKeys "^c"
'Paste the picture in Word.
myWord.Range.Paste