I want copy the scatter smooth chart from Excel to Word as an image in each iteration of a loop. However the previous image keeps being replaced by the next image. Can someone let me know what went wrong with my code?

我希望在循环的每次迭代中将分散平滑图表作为图像从Excel复制到Word。然而，前一幅图像总是被下一幅图像替换。有人能告诉我我的代码出了什么问题吗？

Additional info:

更多信息：

• The loop is to plot multiple groups of data with the same series name from two different worksheets.


• The existing chart needs to be used as a template

My code:

我的代码是：

Sub create_Graph()
    Dim ws1, ws2 As Worksheet
    Dim searchRange, match As Range
    Dim firstMatch As Variant
    Dim currentValue As Variant
    Dim currentRow As Long
    Dim lastRow1, lastRow2 As Long
    Dim startRow1, startRow2 As Long
    Dim endRow1, endRow2 As Long
    Dim myChart As Chart
    Dim wApp As Object
    Dim wDoc As Object
    Dim wPara As Object
    
    'set the worksheet
    Set ws1 = Sh_before
    Set ws2 = Sh_after

    'On Error GoTo errorhandling
    
    'Create the word file
    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    Set wDoc = wApp.Documents.Add
    
    
    
    'Find the last row
    lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    
    'initialize the variables
    startRow1 = 2
    currentValue = ws1.Cells(startRow1, 1).Value

    'Loop throught the row
    currentRow = 3
        
    For currentRow = 3 To lastRow1 + 1
    
        If ws1.Cells(currentRow, 1).Value <> ws1.Cells(startRow1, 1).Value Then
            endRow1 = currentRow - 1
            
            'Set search Range in after data
            Set searchRange = ws2.Range(ws2.Cells(1, 1), ws2.Cells(lastRow2, 1))
            Set match = searchRange.Find(what:=currentValue, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
            
            'Find the fist match
            If Not match Is Nothing Then
                firstMatch = match.Address
                startRow2 = match.Row
                
                'find the last match
                Do
                    Set match = searchRange.FindNext(match)
                    If match.Address = firstMatch Then Exit Do
                    endRow2 = match.Row
                Loop
            
            
            
                'Get the reference for the existing chart
                Set myChart = Sh_data.ChartObjects("PQ_Graph").Chart
                
                'Change the graph title
                myChart.ChartTitle.Text = currentValue
                
                'PQ, before
                myChart.SeriesCollection(1).XValues = ws1.Range(ws1.Cells(startRow1, 4), ws1.Cells(endRow1, 4))
                myChart.SeriesCollection(1).Values = ws1.Range(ws1.Cells(startRow1, 5), ws1.Cells(endRow1, 5))
                
                'PQ_After
                myChart.SeriesCollection(2).XValues = ws2.Range(ws2.Cells(startRow2, 4), ws2.Cells(endRow2, 4))
                myChart.SeriesCollection(2).Values = ws2.Range(ws2.Cells(startRow2, 5), ws2.Cells(endRow2, 5))
                
                'Current_Before
                myChart.SeriesCollection(3).XValues = ws1.Range(ws1.Cells(startRow1, 4), ws1.Cells(endRow1, 4))
                myChart.SeriesCollection(3).Values = ws1.Range(ws1.Cells(startRow1, 7), ws1.Cells(endRow1, 7))
                 
                'Current_After
                myChart.SeriesCollection(4).XValues = ws2.Range(ws2.Cells(startRow2, 4), ws2.Cells(endRow2, 4))
                myChart.SeriesCollection(4).Values = ws2.Range(ws2.Cells(startRow2, 7), ws2.Cells(endRow2, 7))
                            
                'Copy the graph and paste it as picture
                myChart.CopyPicture xlScreen, xlPicture
                wDoc.Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
                          
                'Pause for 1 sec
                Application.Wait Now + TimeValue("00:00:02")
                
                'Create a new page
                wApp.ActiveDocument.Sections.Add
                
                'Go to the new page
                wApp.Selection.Goto what:=wdGoToPage, which:=wdGoToNext
                
                'Clear the clipboard
                Application.CutCopyMode = False
                
            End If
            
            'Go to the next sample no.
            currentValue = ws1.Cells(currentRow, 1).Value
            startRow1 = currentRow

        End If
    Next currentRow
    
    MsgBox "Completed"

End Sub

• I have tried to insert a separator in Word after copy-paste


• I have tried to set a pause in the code


• I have tried clear the flipboard.

However, I still can see the image kept being replaced through the Word window.

然而，我仍然可以通过Word窗口看到图像不断被替换。

Assuming that you want the chart to placed at the end of the document.
Replace:

假设您希望将图表放在文档的末尾。替换：

            wDoc.Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
                      
            'Pause for 1 sec
            Application.Wait Now + TimeValue("00:00:02")
            
            'Create a new page
            wApp.ActiveDocument.Sections.Add
            
            'Go to the new page
            wApp.Selection.Goto what:=wdGoToPage, which:=wdGoToNext

With:

有：

            wDoc.Characters.Last.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
                      
            'Pause for 1 sec
            Application.Wait Now + TimeValue("00:00:02")
            
            'Create a new page
            wDoc.Sections.Add