问题描述
我正在尝试找出如何替换单词中插入书签后面的数字。我有一些工作代码,可以在其中粘贴新图,然后删除旧图(如果已经存在)。但是最好替换现有的。要手动执行此操作,我将右键单击该图,然后选择从剪贴板更改图片。我尝试使书签包含该图,但它还会粘贴另一个,而不是在其位置替换现有的。谁能帮忙找到解决方案?
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
解决方法
暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!
如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@)