用Excel替换Word中的图形

如何解决用Excel替换Word中的图形

我正在尝试找出如何替换单词中插入书签后面的数字。我有一些工作代码，可以在其中粘贴新图，然后删除旧图（如果已经存在）。但是最好替换现有的。要手动执行此操作，我将右键单击该图，然后选择从剪贴板更改图片。我尝试使书签包含该图，但它还会粘贴另一个，而不是在其位置替换现有的。谁能帮忙找到解决方案？

Sub CopyFiguresToWord()

' Select PSD graph in excel and copy to GIR in word

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
 
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wdApp As Word.Application
    Dim GIR As Word.Document
    Dim GIRName As String
    Dim GEOL As String
    Dim GEOLBKM As String
    Dim PSD As Word.Range
    Dim GEOLPSD As String
                        
    Set wdApp = New Word.Application '<<<  Create a Word application object
    wdApp.Visible = True '<<<< Open word so you can see any errors
    
    GIRName = Application.GetOpenFilename(Title:="Please choose GIR to open",_
                                          FileFilter:="Word Files *.docm* (*.docm*),")
    Set GIR = wdApp.Documents.Open(GIRName) '<< call Documents.Open on the word app
    
    'Loop through excel workbook to copy data
    Set wb = ThisWorkbook
    Set ws = ActiveSheet
    For Each ws In wb.Worksheets
        If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
            ws.Name = Replace(ws.Name,"(Blank)","NoGEOLCode")
            ws.Activate
            GEOL = Range("B31").Value
            GEOLBKM = Replace(GEOL," ","")
            GEOLPSD = GEOLBKM & "PSD"
            'Copy PSD graph
            Range("B2:Q28").Copy
            
            'Check if PSD bookmark already exists?
            If GIR.Bookmarks.Exists(GEOLPSD) Then
            'This will add another picture rather than replace the existing one...
            Set PSD = wdApp.ActiveDocument.Bookmarks(GEOLPSD).Range
            PSD.PasteSpecial Link:=False,DataType:=wdPasteEnhancedMetafile,_
                Placement:=wdInLine,DisplayAsIcon:=False
            PSD.InsertCaption Label:="Figure",TitleAutoText:="",Title:= _
                " - " & GEOL & " particle size distribution",Position:=wdCaptionPositionBelow,ExcludeLabel:=0
            
            'Delete existing PSD and caption
            wdApp.Selection.GoTo What:=wdGoToBookmark,Name:=GEOLPSD
            wdApp.Selection.MoveDown Unit:=wdLine,Count:=2
            wdApp.Selection.MoveRight Unit:=wdWord,Count:=1,Extend:=wdExtend
            wdApp.Selection.MoveDown Unit:=wdLine,Extend:=wdExtend
            wdApp.Selection.Delete Unit:=wdCharacter,Count:=1
                        
            'Check if GEOL bookmark exists?
            ElseIf GIR.Bookmarks.Exists(GEOLBKM) Then
                    wdApp.Selection.GoTo What:=wdGoToBookmark,Name:=GEOLBKM
                    wdApp.Selection.EndKey Unit:=wdLine
                    wdApp.Selection.TypeParagraph
                    'Add new bookmark for PSD
                    With wdApp.ActiveDocument.Bookmarks
                        .Add Range:=wdApp.Selection.Range,Name:=GEOLPSD
                        .DefaultSorting = wdSortByName
                        .ShowHidden = False
                    End With
                    Set PSD = wdApp.ActiveDocument.Bookmarks(GEOLPSD).Range
                    PSD.PasteSpecial Link:=False,_
                        Placement:=wdInLine,DisplayAsIcon:=False
                    PSD.InsertCaption Label:="Figure",Title:= _
                        " - " & GEOL & " particle size distribution",ExcludeLabel:=0
                    
            Else
                    'If GEOL or PSD bookmark don't exist add new bookmark for PSD
                    'Go to start of Ground summary section and insert bookmark for Geology
                    wdApp.Selection.GoTo What:=wdGoToHeading,Which:=wdGoToFirst,Count:=5,Name:=""
                    wdApp.Selection.EndKey Unit:=wdLine
                    wdApp.Selection.TypeParagraph
                    With wdApp.ActiveDocument.Bookmarks
                        .Add Range:=wdApp.Selection.Range,Name:=GEOLBKM
                        .DefaultSorting = wdSortByName
                        .ShowHidden = False
                    End With
                    wdApp.Selection.Style = wdApp.ActiveDocument.Styles("Heading 2")
                    wdApp.Selection.TypeText Text:=GEOL
                    wdApp.Selection.TypeParagraph
                    'Insert bookmark for PSD
                    With wdApp.ActiveDocument.Bookmarks
                        .Add Range:=wdApp.Selection.Range,ExcludeLabel:=0
                   
            End If
        End If
    Next
    
    
    
    
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
   

End Sub