Vba 将链接图像转换为嵌入图像

我有很多包含链接图像的Word文件。这些Word文件是在网络驱动器上自动创建的，位于必须定期清空的临时文件夹中

因此，我必须将Word文件移动到另一个文件夹进行归档。 当我移动Word文件时，图像始终指向临时文件夹。删除临时文件夹时，移动的Word文件不再具有工作图像

有两种方法可以解决此问题：

• 将链接图像转换为嵌入图像
• 更改链接图像到存档文件夹的路径

我知道我可以通过“文件->编辑文件链接”手动执行此操作，但我更喜欢通过宏执行此操作。此宏同时执行以下两项操作：首先更改存档文件夹的路径，然后断开链接：

Sub ConvertLinkedImagesToEmbedded()
Dim i As Integer
Dim OldName As String
Dim OldPath As String
Dim NewPath As String
    For i = 1 To ActiveDocument.InlineShapes.Count
        ActiveDocument.InlineShapes.Item(i).Select
        If ActiveDocument.InlineShapes.Item(i).Type = wdInlineShapeLinkedPicture Then
            OldName = ActiveDocument.InlineShapes.Item(i).LinkFormat.SourceName
            OldPath = ActiveDocument.InlineShapes.Item(i).LinkFormat.SourcePath
            NewPath = ActiveDocument.Path & "\" & OldName
            Dim Ext As String
                If FileThere(NewPath) Then
                  Selection.InlineShapes.AddPicture FileName:=NewPath, LinkToFile:=False, SaveWithDocument:=True
                  ActiveDocument.InlineShapes.Item(i).LinkFormat.Update
                Else
                MsgBox "ConvertLinkedImagesToEmbedded: image file " & NewName & " does not exist.", vbOKOnly
                End If
            End If
    Next i
End Sub

Function FileThere(FileName As String) As Boolean
    FileThere = (Dir(FileName) > "")
End Function

这看起来应该是可行的：当我运行它时，每个图像的类型都从WDINLINESHAPELINKEDPPICTURE更改为WDINLINESHAPECTURE。 文件大小也会更改，表示图像已嵌入到文件中。当我删除临时文件夹时，Word文件仍然显示图像

但当我转到“文件->编辑文件链接”时，所有图像仍然作为链接图像列出。更糟糕的是，链接仍然指向临时文件夹。因此，如果有人使用此对话框更新其中一个文件，他将丢失图像

---

所以问题是，我如何才能获得文件->编辑文件链接对话框来显示图像的正确状态（即嵌入）

我在寻找取消链接图片的方法时，偶然发现了原始帖子；这就是我的结局。我让它在图片上添加边框，以验证它是否做了什么；如果不需要，很容易注释掉

Sub BreakPictureLinks()

Dim intCount As Integer
Dim i As Integer

With ActiveDocument

'loop through inline shapes
For i = 1 To .InlineShapes.Count

    With .InlineShapes(i)
        'check if the current shape is a linked picture
        If .Type = wdInlineShapeLinkedPicture Then

            ' Give it a border
           .Line.BackColor = vbBlack
           .Line.Weight = 1
           .Line.Style = msoLineSingle

            ' unlink it
            '.LinkFormat.SavePictureWithDocument = True
            .LinkFormat.BreakLink

        End If
    End With

Next i

End With    ' Active document

End Sub

---

我只是在寻找一种方法来取消链接图片时偶然发现了原始帖子；这就是我的结局。我让它在图片上添加边框，以验证它是否做了什么；如果不需要，很容易注释掉

Sub BreakPictureLinks()

Dim intCount As Integer
Dim i As Integer

With ActiveDocument

'loop through inline shapes
For i = 1 To .InlineShapes.Count

    With .InlineShapes(i)
        'check if the current shape is a linked picture
        If .Type = wdInlineShapeLinkedPicture Then

            ' Give it a border
           .Line.BackColor = vbBlack
           .Line.Weight = 1
           .Line.Style = msoLineSingle

            ' unlink it
            '.LinkFormat.SavePictureWithDocument = True
            .LinkFormat.BreakLink

        End If
    End With

Next i

End With    ' Active document

End Sub

---

只要看看您的代码（即，我实际上还没有试过运行它，可能有几周没有时间进一步查看），我猜您正在成功地在Selection.InlineShapes行中添加一个额外的未链接图片，但随后尝试更新现有链接。选择行可能没问题，但可能你需要删除现有的InlineShape（并且你可能需要调整你的循环，因为下一个InlineShape的索引可能会因此改变）。@Hobbes:你能解决上述问题吗？我必须检查我是如何处理的，但目前无法访问该项目。将在几周内检查。只需查看您的代码（即，我实际上还没有尝试运行它，并且可能在几周内没有时间进一步查看），我猜您正在成功地在Selection.InlineShapes行中添加其他未链接的图片，但随后尝试更新现有链接。选择行可能没问题，但可能你需要删除现有的InlineShape（并且你可能需要调整你的循环，因为下一个InlineShape的索引可能会因此改变）。@Hobbes:你能解决上述问题吗？我必须检查我是如何处理的，但目前无法访问该项目。我将在几周内办理入住手续。