将图片和表格链接到MS Word

Question

将图片和表格链接到MS Word

3

我希望自动化填写Word报告的过程。我的文档有大约400页，包含数百个图表。我使用Matlab处理数据，将图形保存到组织好的文件夹中，并在Excel文件模板的不同选项卡中填充预格式化的表格。我对这方面很满意，但是复制和粘贴填写Word报告非常耗时。

我即将做一个非常类似的报告，并且我想完全消除填写报告的C和P部分，无论是保存在文件夹中的图像还是汇总表格选项卡中的表格。如果能设置一个模板，自动刷新就更好了，因为有时表格和图像的构建过程是迭代的。我有一点VBA数据处理经验，但是没有用于此应用程序的经验。我该从哪里开始？求给予指引或类似问题的链接。

- user1854628

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Automate This · Accepted Answer

如果您插入与文件链接的图片对象，当文件名更改时它们会自动更新。这假定您始终拥有相同数量的图片且名称不变。

    Selection.InlineShapes.AddOLEObject ClassType:="Paint.Picture", FileName:= _
      "C:\Users\name\Pictures\test.bmp", LinkToFile:=True, DisplayAsIcon:= _
      False

假设您已经设置了一个包含模板Word文档的文件夹，其中包含指向另一个文件夹的图像链接，并且您想确保这些图像链接到以日期（例如20131008）命名的最新文件夹。您可以将图像链接到文件以进行自动更新，但由于其只读属性，无法以编程方式更改源路径。替代方法是循环遍历Word文档中的每个对象，查看它的路径是否为当前文件夹，如果不是，则删除原始对象并插入一个新对象。

以下是一个简单示例的代码。如果在插入图像后对其进行了任何增强，则可能需要复制定位和格式。我将我的文件夹结构设置如下，其中每个以日期命名的文件夹都有相同名称的图像。

对于OLE类型链接到.bmp图像：

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类型的图像。这假设您是通过以下方法插入图像：

enter image description here

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