如果您为链接到文件的图片插入对象会怎样。这样当文件名更改时它们会自动更新?这假设您始终拥有相同数量的图片并且名称不会更改。
Selection.InlineShapes.AddOLEObject ClassType:="Paint.Picture", FileName:= _
"C:\Users\name\Pictures\test.bmp", LinkToFile:=True, DisplayAsIcon:= _
False
假设您有一个使用模板 word 文档设置的文件夹,该文档具有指向另一个文件夹的图像链接,并且您希望确保这些图像链接到以日期命名的最新文件夹,例如 20131008。您可以将图像链接到用于自动更新的文件,但由于它是只读属性,因此您无法以编程方式更改源路径。另一种方法是遍历word文档中的每个对象,看看它的路径是否是当前文件夹,如果不是,则删除原始文件夹并插入一个新文件夹。
下面是一个简单示例的代码。如果在插入图像后对图像进行了任何增强,则可能必须复制定位和格式。我按如下方式设置我的文件夹结构,其中名称为日期的每个文件夹都有同名的图像。
对于 .bmp 图像的 OLE 类型链接
Sub LinkToCurrentImageFolder()
'Get current folder by date
Dim clientFiguresPath As Variant
filePath = ActiveDocument.Path & "\ClientFigures\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(filePath)
Dim currentFolder As Variant: currentFolder = ""
For Each sf In fld.SUBFOLDERS
'Look at name and get current date
If currentFolder = "" Then
currentFolder = sf.Path
ElseIf sf.Path > currentFolder Then
currentFolder = sf.Path
End If
Next
' Debug: display current figure folder path
'MsgBox (currentFolder)
'Loop through all shapes in document and check if path is current.
'If path is not current delete current shape and add new because SourcePath is read-only
Dim Ishape As InlineShape, Wdoc As Document
MsgBox (ActiveDocument.InlineShapes.Count)
For Each Ishape In ActiveDocument.InlineShapes
If Not GetSourceInfo(Ishape) Then GoTo nextshape
With Ishape
currentPath = .LinkFormat.SourcePath
If currentPath <> currentFolder Then
cType = .OLEFormat.ClassType
shpName = .LinkFormat.SourceName
newPath = currentFolder & "\" & shpName
'Delete existing image
.Delete
'Create new image
Selection.InlineShapes.AddOLEObject ClassType:=cType, FileName:=newPath, LinkToFile:=True, DisplayAsIcon:=False
End If
End With
nextshape:
Next Ishape
End Sub
Function GetSourceInfo(oShp As InlineShape) As Boolean
On Error GoTo Error_GetSourceInfo
Test = oShp.LinkFormat.SourceFullName
GetSourceInfo = True
Exit Function
Error_GetSourceInfo:
GetSourceInfo = False
End Function
编辑
我已更改此代码以使用链接到文件但不是 OLE 类型的图像。这假设您通过这种方法插入图像:
Sub LinkToCurrentImageFolder()
'Get current folder by date
Dim clientFiguresPath As Variant
filePath = ActiveDocument.Path & "\ClientFigures\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(filePath)
Dim currentFolder As Variant: currentFolder = ""
For Each sf In fld.SUBFOLDERS
'Look at folder name/date and get most current date
If currentFolder = "" Then
currentFolder = sf.Path
ElseIf sf.Path > currentFolder Then
currentFolder = sf.Path
End If
Next
Dim Ishape As InlineShape
For Each Ishape In ActiveDocument.InlineShapes
If Ishape.Type = msoComment Then
With Ishape
currentPath = .LinkFormat.SourcePath
If currentPath <> currentFolder Then
shpName = .LinkFormat.SourceName
newPath = currentFolder & "\" & shpName
'Delete existing image
.Delete
'Create new image
Selection.InlineShapes.AddPicture FileName:=newPath, LinkToFile:=True, SaveWithDocument:=True
End If
End With
End If
Next Ishape
End Sub