将 Excel 图表复制并粘贴到 Word 中，无需链接或另存为 GIF

Posted 2023-02-19

【中文标题】将 Excel 图表复制并粘贴到 Word 中，无需链接或另存为 GIF

【英文标题】：Copy and paste an excel chart into word without linking or saving as a GIF

【发布时间】：2017-08-14 21:14:46

【问题描述】：

我完全是 VBA 新手，但我设法拼凑了一些代码，使我可以将 excel 2010 图表导出到新的 Word 2010 文档中。我唯一的问题是，一旦导出图表，我想从 excel 中取消链接，以便在更新 excel 时它不会改变。我到处看了看，但似乎没有任何效果。

似乎符合要求的唯一其他代码获取图表并在粘贴之前将其保存为图像，但这不起作用，因为我无处保存图像 - 我们组织中的用户无权访问C:\ 驱动器，在不知道每个人的用户详细信息的情况下，我无法编写可以完成这项工作的代码。

到目前为止，我编写的代码是这样的，它确实有效，但无法取消链接：

 Sub Copy_Paste_Report_1_Graph_to_new_word_document()
'
'Copy/Paste An Excel Chart Into a New Word Document
'(VBE > Tools > References > Microsoft Word 12.0 Object Library)

'Excel Objects
Dim ChartObj As ChartObject

'Word Objects
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False



'Copy Chart from Excel
  Set ChartObj = Worksheets("External Dashboard").ChartObjects("Chart 1")

'Create an Instance of MS Word
  On Error Resume Next

    'Is MS Word already opened?
      Set WordApp = GetObject(class:="Word.Application")

    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0

'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate

'Create a New Document
  Set myDoc = WordApp.Documents.Add

'Copy Excel Chart
  ChartObj.Copy

'Paste Chart into MS Word
  myDoc.Paragraphs(1).Range.PasteSpecial Link:=False _

EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False
End Sub

我可能包含的内容超出了我的需要，但就像我说的，我是新手。

【问题讨论】：

为什么不试试ChartObj.CopyPicture xlScreen, xlPicture 和myDoc.Paragraphs(1).Range.PasteSpecial？

完美！！谢谢！效果很好。

已将解决方案作为答案发布，如果有帮助，请点击接受。

【参考方案1】：

使用.CopyPicture 和.PasteSpecial 方法：

Sub Copy_Paste_Report_1_Graph_to_new_word_document()

    Dim ChartObj As ChartObject
    Dim WordApp As Word.Application
    Dim myDoc As Word.Document

    Set ChartObj = Worksheets("External Dashboard").ChartObjects("Chart 1")
    Set WordApp = CreateObject(class:="Word.Application")
    WordApp.Visible = True
    WordApp.Activate
    Set myDoc = WordApp.Documents.Add
    ChartObj.CopyPicture xlScreen, xlPicture
    myDoc.Paragraphs(1).Range.PasteSpecial

End Sub