Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/23.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 将多个图表复制到word文档_Excel_Ms Word_Vba - Fatal编程技术网

Excel 将多个图表复制到word文档

Excel 将多个图表复制到word文档,excel,ms-word,vba,Excel,Ms Word,Vba,我正试图将一张工作表中的一系列图表复制到word中的一个文档中,但由于某些原因,我只能得到最新的粘贴(即工作表上的最后一张图表)。我知道迭代会遍历所有的图表,因为当我修改代码为每个图表打印一个单词文档时,它会这样做,但我希望这些图表都在一起,所以请帮助我 守则: Sub ChartsToWord() Dim WDApp As Word.Application Dim WDDoc As Word.Document Dim iCht As Integer Dim Msg As String Se

我正试图将一张工作表中的一系列图表复制到word中的一个文档中,但由于某些原因,我只能得到最新的粘贴(即工作表上的最后一张图表)。我知道迭代会遍历所有的图表,因为当我修改代码为每个图表打印一个单词文档时,它会这样做,但我希望这些图表都在一起,所以请帮助我

守则:

Sub ChartsToWord()

Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim iCht As Integer
Dim Msg As String

Set WDApp = CreateObject("Word.Application")
Set WDDoc = WDApp.Documents.Add

For iCht = 1 To ActiveSheet.ChartObjects.Count
    ' copy chart as a picture
    ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture


    WDDoc.Content.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
        Placement:=wdInLine, DisplayAsIcon:=False

    WDDoc.Content.InsertParagraphAfter
Next
WDDoc.SaveAs ("C:\Users\confidential\Documents\charts.doc")
    WDDoc.Close ' close the document

' Clean up
    Set WDDoc = Nothing
    Set WDApp = Nothing

End Sub

请将
PasteSpecial
行的开头替换为:

WDApp.Selection.Range.PasteSpecial ... 'and so on
在您的情况下,您可以将图表粘贴到整个文档中,而不是当前段落中

还有一个建议。您可以使用以下内容插入新段落:

WDApp.Selection.MoveEnd wdStory
WDApp.Selection.Move

请将
PasteSpecial
行的开头替换为:

WDApp.Selection.Range.PasteSpecial ... 'and so on
在您的情况下,您可以将图表粘贴到整个文档中,而不是当前段落中

还有一个建议。您可以使用以下内容插入新段落:

WDApp.Selection.MoveEnd wdStory
WDApp.Selection.Move