如何将嵌入图片从 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中时，它实际上复制了链接图像（图标），而不是底层嵌入图像。

到目前为止我发现了什么： 这段代码向我展示了如何创建嵌入对象，但不展示如何复制对象。

Answer 1

更新：更简单的解决方案

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

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 的次优解决方案 -受此链接启发。我非常相信，通过探索提取 的OLEObject属性的方法，您可以更优雅地做到这一点。在撰写本文时，提取这些内容超出了我的专业范围:-)

它围绕着OLEObject。此代码执行图片的 OLE 对象的主机应用程序（在本例中为 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