查找/替换 OLE 链接的问题

Question

我正在开发一个基于 Excel 的模板，以直接与相应的 Powerpoint 模板链接，并在此过程中发现 MS 的相对链接通过默认为父目录而发生了变化（将链接的文件留在同一文件夹中意味着它们可以被移动/复制/等，链接会更新）。

我在 Excel VBA 中尝试了一些解决方案，目前唯一可行的选项包括将 PPT 保存为 XML 文件，然后使用传入的变量构造的新文件路径查找/替换 (PowerShell) 旧文件路径来自 Excel 文件。

Sub ChangeOLELinks()

Dim oSld As Slide
Dim oSh As Shape
Dim sOldPath As String
Dim sNewPath As String


sOldPath = "C:\__oldpath\oldfolder\old.xlsm"
sNewPath = "C:\__New Dangerous\Dangerous.xlsm"


For Each oSld In ActivePresentation.Slides
    For Each oSh In oSld.Shapes
        ' Change only linked OLE objects
        If oSh.Type = msoLinkedOLEObject Then
            On Error Resume Next
            ' Verify that file exists
            If Len(Dir$(Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath))) > 0 Then
                 oSh.LinkFormat.SourceFullName = Replace(oSh.LinkFormat.SourceFullName, oSh.LinkFormat.SourceFullName, sNewPath)
            End If
         End If
    Next    ' shape
Next    ' slide

MsgBox ("Done!")

上面的代码运行并更新了链接，但只是一些。我的 PPT 包含直接来自工作表和图表的链接“网格”，无论出于何种原因，下面的代码仅更新网格。

即使有解决方法来更新所有形状/OLE 对象，有没有办法可以从 Powerpoint VBA 中的 Excel 工作表中传递变量？

Answer 1

虽然我无法让这个宏在 PPT 中充分发挥作用，但我发布了我正在使用的解决方案。当 PPT 保存为 XML（幻灯片大小更新不带图像拉伸）时，我在记事本中使用 find/replace 取得了成功，因此能够通过 PowerShell 复制和自动化相同的过程。

唯一的细微差别是我通过我通过 VBA 链接到 PPT 的 Excel 文件调用 PowerShell 脚本；原因是我可以从工作表中传递文件路径/文件名信息并避免需要用户输入。下面是PS脚本：

param(
[string]$ReplaceStr_1,
[string]$ReplaceStr_2,
[string]$ReplaceStr_3,
[string]$OUTPUTfilepath)

[string]$FindStr_1,
[string]$FindStr_2,
[string]$FindStr_3,

[String]$templatefile



$FindStr_1 = "C:\Reports%20Folder\template\NewReportTemplate001.xlsm"
$FindStr_2 = "C:\Reports Folder\template\NewReportTemplate001.xlsm"
$FindStr_3 = "[NewReportTemplate001.xlsm]"

$templatefile = "C:\Reports Folder\_MasterData\NewReportPresentation.xml"

Get-Content $templatefile | 
Foreach-Object { 
$_ -Replace [regex]::Escape($FindStr_1), $ReplaceStr_1 `
   -Replace [regex]::Escape($FindStr_2), $ReplaceStr_1`
   -Replace [regex]::Escape($FindStr_3), $ReplaceStr_3
} | Set-Content $OUTPUTfilepath
echo $OUTPUTfilepath

[Environment]::Exit(1)

有关其他信息，我正在使用 CELL("filename",) 函数生成我的动态文件路径以传递给上面的 PS 参数。

下面是 VBA 宏供参考：

Sub BuildISLxmlPPT()
    Dim FR1 As String
    Dim FR2 As String
    Dim FR3 As String
    Dim psOUT As String

    FR1 = Range("xmlFR1").Value
    FR2 = Range("xmlFR2").Value
    FR3 = Range("xmlFR3").Value
    vbaOUT = Range("xmlOUT").Value

    strCommand = "Powershell -noprofile -File ""C:\Reports Folder\_MasterData\FindReplacePPTXML.ps1"" -psFR1 """ & FR1 & """ -psFR2 """ & FR2 & """ -psFR3 """ & FR3 & """ -OUTPUT """ & vbaOUT & """"

    Set WshShell = CreateObject("WScript.Shell")
    Set WshShellExec = WshShell.exec(strCommand)
    strOutput = WshShellExec.StdOut.ReadAll

    MsgBox "New PPT.xml file generated here: " & strOutput, _
    Buttons:=vbInformation, _
    Title:="Perfection"