将excel图表复制并粘贴到单词中,无需链接或保存为GIF

我是一个总的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 

我可能包括了比我需要的更多,但是就像我说的,我是一个新手。

使用.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