VBA 复制word图片到excel

Posted 2023-04-23

Sub trial()
Dim WordApp As Word.Application

Dim TargetFile As Word.Document
Dim WordShape As InlineShape
Dim WordShapeNum As Integer

On Error Resume Next
Set WordApp = CreateObject("word.application")
Set TargetFile = WordApp.Documents.Open("C:\Users\nsgtyang\Desktop\target.doc")
WordApp.Visible = True

'*********************************************************************************
Documents("target.doc").Activate '激活该word文档
Let WordShapeNum = ActiveDocument.InlineShapes.Count

MsgBox (WordShapeNum)

Set WordShape = WordApp.ActiveDocument.InlineShapes(2)
WordShape.Select
Selection.Copy
'**********************************************************************************
Workbooks("Bench Test Report").Activate

ActiveWorkbook.Worksheets("Brown Out & Brown In").Activate

ActiveSheet.Range("A1").Select
Selection.Paste

目的就是word文档里有很多波形数据，现在想要将波形（应该是图片类型）拷贝到excel中指定位置。 现在发现通过上面的代码可以选中但是就是不能拷贝过去，而且msgbox想统计波形的数量也统计不到。 而相同代码在word vba里就能实现，这是为什么？

参考技术A word里面操作的vba跟excel里面是有区别的。不能生搬硬套啊

将图片从 Excel 形状复制到 VBA 中的图像对象

【中文标题】将图片从 Excel 形状复制到 VBA 中的图像对象

【英文标题】：Copy picture from Excel shape to Image object in VBA

【发布时间】：2017-07-28 07:18:48

【问题描述】：

我想使用 VBA 将已插入 Excel 电子表格的图片复制到 Image 对象。这是我尝试过的代码：

Dim logo As Image
Set logo = New Image
logo.Picture = ThisWorkbook.Sheets("Sheet1").Pictures("Picture1")

最后一行因类型不匹配错误而失败。当我在监视窗口中查看 logo.Picture 时，它​​被列为图片类型；当我将一个对象变量分配给等号右侧的表达式时，它被列为图片/图片类型。我对 VBA 对象层次结构不够熟悉，不知道这些类型是否相关，也不知道如何从一种类型转换为另一种类型，尽管 Google 搜索了很多，但我还是找不到任何相关信息。

如果我用这个替换最后一行：

logo.Picture = LoadPicture(ThisWorkbook.Path & "\Logo.bmp")

文件加载，我的程序的其余部分工作。我在这里和其他地方搜索了很多帖子，除了建议将图像导出到文件然后使用LoadPicture 将其导入到 Image 对象之外，没有发现任何有用的东西。关于如何从工作表而不是文件中获取图片的任何建议？

如果重要，其余代码使用 logo.Picture.Handle 作为 GDI 位图 HANDLE，并将其传递给外部库以在外部设备上显示图像。如果有办法从不同的对象获取 GDI 位图 HANDLE，那也可以。

【问题讨论】：

你试过ThisWorkbook.Sheets("Sheet1").Shapes("Picture1")吗？ （顺便说一句。通常对象默认命名为空格“图片 1”，另外，各种 Excel 语言版本中的名称可能不同）另外，我无法重新创建您的错误，因为似乎图像类型需要一些未在您的问题中披露的额外参考。

【参考方案1】：

改为将其定义为Object 并使用Set 将您的图像分配给它：

Dim Logo As Object
Set Logo = ThisWorkbook.ActiveSheet.Pictures("Picture 1")

【参考方案2】：

您是否尝试将其作为OLEObject 插入？

Me.logo.Picture = ThisWorkbook.Worksheets("Sheet1").OLEObjects("Picture1").Object.Picture

您要复制的图像应作为图像（ActiveX 控件）插入到工作表中。

【参考方案3】：

Excel 对象模型中没有 Image 对象，但有一个 Picture 对象（未记录）。

Dim logo As Picture
Set logo = ThisWorkbook.Sheets("Sheet1").Pictures("Picture1")