将 Word 文档中的图像复制到 Excel 单元格中

编程问答 2022-05-18

问题描述

我想将 Word 文档中的图片复制到 Excel 中的单元格中，但每次尝试粘贴图片时，我都会收到一个“\”。

有人可以帮我吗？

有没有简单的方法可以在 VBA 中进行这个操作？

我使用选择在两章之间进行搜索（选择效果很好，但副本没有。）

我的代码如下：

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\test.docx")
Dim r1 As Long


wrdApp.Selection.WholeStory
wrdApp.Selection.Find.ClearFormatting
With wrdApp.Selection.Find
     .Text = "ABCD"
     .Forward = True
     .Wrap = wdFindContinue
     .Format = False
     .MatchCase = False
     .MatchWholeWord = True
     .MatchWildcards = False
     .MatchSoundsLike = False
     .MatchAllWordForms = False
     .Execute
End With
r1 = wrdApp.Selection.Range.End

wrdApp.Selection.Find.Text = "BCDE"
If wrdApp.Selection.Find.Execute Then
    wrdApp.Selection.Collapse wdCollapseStart
Else
    wrdApp.Selection.WholeStory
    wrdApp.Selection.Collapse wdCollapseEnd
End If
     
wrdDoc.Range(r1,wrdApp.Selection.Start).Select

With wrdApp.Selection
    MySheet.Range("B3").Value = .Inlineshapes(1)
End With

解决方法

您的代码有几个问题。

  1. 变量 MySheet 没有声明，也没有指向任何东西。 因此，您的代码无法编译。

  2. 虽然您的问题提到使用复制和粘贴您的代码 不复制或粘贴任何内容。

  3. 单元格的 .Value 不能是图片。

  4. 在使用 VBA 时，无论是在 Excel、PowerPoint 还是 Word 中，最好 避免使用 Selection 对象，而是使用 Range。

    Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")

wrdApp.Visible = True

Set wrdDoc = wrdApp.Documents.Open("C:\test.docx")

Dim r1 As Word.Range
Set r1 = ActiveDocument.Range

With wrdDoc.Range
    With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "ABCD"
        .Format = False
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = False
    End With
    If .Find.Execute Then r1.Start = .End

    .Find.Text = "BCDE"
    If .Find.Execute Then r1.End = .Start
End With

r1.InlineShapes(1).Range.Copy

ThisWorkbook.Sheets(1).Range("B3").PasteSpecial

wrdDoc.Close False
wrdApp.Quit
excelexcelms-word