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

我拥有的： 一种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

“图像对象”
作为形状的模糊myobj
暗myObj As形状
设置myObjs=ActiveSheet.Shapes
'遍历对象
将行设置为整数
将myRange变暗为Range
将myRange2变暗为范围
Dim isAddressMatch作为布尔值
'Word文档对象
Dim wordApp作为新单词。应用程序
将myWord设置为Word.Document
'为输出准备单词
设置myWord=wordApp.Documents.Add
可见=True
'初始化遍历对象
设置我的范围=工作表（“我的工作表”）。范围（“Q5”）
设置myRange2=工作表（“我的工作表”）。范围（“E5”）
行=0
'循环所需列中的范围值
While（myRange2.Offset（行）.Value“”）
'循环遍历所有形状对象，直到找到地址匹配。
对于myObj中的每个myObj
出错时继续下一步
isAddressMatch=（myObj.TopLeftCell.Address=myRange.Offset（row.Address）
如果错误号为0，则
isAddressMatch=False
错误转到0
如果结束
'找到匹配项后，将bmp图片从Excel复制到Word
如果（isAddressMatch）那么
myObj.选择
复制excel默认图片
不是嵌入的图片
myObj.CopyPicture“复制myObj的正确方法是什么
myWord.Range.Paste
'代码的其余部分尚未实现
如果结束
下一个
行=行+1
温德

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

到目前为止我所发现的： 这向我展示了如何创建嵌入对象，但没有演示如何复制

更新：更简单的解决方案 如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——灵感来源于。我确信，通过探索提取

OLEObject

属性的方法，您可以更优雅地实现这一点。在撰写本文时，提取这些信息超出了我的专业范围：-）

它围绕对象旋转。此代码执行图片的（在本例中为绘制），发送复制图片的键，最后将其粘贴到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

---

我不是一个编码员，但我发现如果你为一个单元格范围“定义名称”，你可以用定义的名称做各种事情。例如：

将Excel工作簿行链接到Word文档 1.打开Excel工作簿转到公式->定义名称 2.为要链接的每个单元格或单元格组创建一个“名称”。 例如，我将Word文档中的一个问题超链接到Excel文档，该文档用于将问题导入我们的学习管理系统。示例名称=问题22，参考单元格范围=WBT16DS058$A$90（=工作表！单元格范围） 3.保存并关闭Excel工作簿。 4.打开Word文档并创建文本（问题022），突出显示并插入超链接。 5.浏览并选择Excel文档，在地址末尾添加#NAME。（即-R312Test.xlsx#问题22）。 6.选择新链接，Excel文档将打开到单元格区域

因为您正在为单元格范围定义名称，所以即使在移动单元格时，链接也将保持活动状态

我想知道你是否使用“定义名称”为你的细胞范围，包括图片，你试图嵌入，你会有运气

---

如果您已经定义了单元格区域的名称并尝试了此操作，我深表歉意

如果您只是执行

myObj.Copy

而不是

.CopyPicture

，会怎么样？另外，您在哪里指定要粘贴到的范围？我只是看到了

myWord.Range.Paste

（虽然我承认，我对Word的VBA速度不是很快，所以这可能是Word的

Range

？）我尝试了

myObj.Copy

，得到了与

.CopyPicture

相同的结果。对于word文档，我只需要将其粘贴到其中，范围无关紧要。“…范围无关紧要”-理解，但我想问

.range.

在

myWord.range.Paste中打算做什么？（我很好奇，我以前没有见过像这样使用
Range
，好吧）…如果你只做
myWord.Paste
，会发生什么？
myWord
是word文档对象，下面有所有相应的方法。范围方法基于字符位置。更多细节请参见。你为我指明了正确的方向。下面是我为避免使用send键所做的工作：首先创建OLE对象，然后使用
obj.copy
复制它。最后，当我使用
myWord.Range.Paste
时，它会将实际图像（而不是图标）粘贴到word中。谢谢。@jspek好极了。我将更新我的答案，以包括您更简单的解决方案。