Question

我想自动完成在Word中填充报表的过程。我在一个约400页的文档中有几百个数字和表格。我使用Matlab处理我的数据，将数字保存到有组织的文件夹，并在Excel文件模板的不同选项卡中填充预先格式化的表格。我很高兴看到它的这一面，但是用复制和粘贴填充Word报告是时间密集的。

我很快会做一个非常相似的报告，我想完全删除填充报告的C和P部分，包括保存在文件夹中的数字和摘要的特定选项卡中的表格片。如果我可以设置一个自动刷新的模板，那将是很棒的，因为有时表格和图形构建过程是迭代的。我在VBA中处理数据的经验很少，但对此应用程序没有任何帮助。我从哪里开始？我们非常感谢正确方向的碰撞或类似问题的链接。

Answer 1

如果为链接到文件的图片插入对象，该怎么办？这样他们会在文件名更改时自动更新？这假设您总是拥有相同数量的图片并且名称不会改变。

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

假设您设置了一个文件夹，其中包含一个模板文档文档，该文档具有指向另一个文件夹的图像链接，并且您希望确保这些图像链接到由日期（例如20131008）命名的最新文件夹。您可以链接要备份的图像用于自动更新，但由于它的只读属性，您无法以编程方式更改源路径。另一种方法是遍历word文档中的每个对象，查看它的路径是否是当前文件夹，如果不是，则删除原始文件并插入新文件。

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

enter image description here

对于.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类型的图像。这假设您通过此方法插入图像：

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

链接的图像和表格到MS Word

1 个答案: