从不同目录中的相同工作簿更新 Powerpoint 中的链接（通过 vba？）

Question

我正在将 powerpoint (ppt) 幻灯片中的图表链接到 Excel (xls) 工作簿中的图表。这在没有 vba 代码的情况下可以正常工作，因为我只是使用特殊粘贴来创建链接。然而，问题是当我更改 ppt 和 xls 的目录时，因为 ppt 仍会尝试从旧目录中的 xls 更新数据。然而我的目标是分享这些文件，这样每个人都可以用他们的 xls 更新他们的 ppt。

所以，简而言之，我想更新 ppt，但选择不同的工作簿（具有不同的目录）。此工作簿在结构上与旧工作簿相同，只是数据不同。

我知道有方法 updatelinks，但似乎没有任何方法可以使用此方法选择不同的目录。有人有什么建议吗？

Answer 1

所以，简而言之，我想更新 ppt，但选择不同的工作簿（具有不同的目录）。此工作簿在结构上与旧工作簿相同，只是数据不同。

已在 MS-OFFICE 2010 中试用和测试

我已经对代码进行了注释，以便您理解它不会有问题。如果您仍然这样做，请随时询问。

Option Explicit

Sub UpDateLinks()
    '~~> Powerpoint Variables/Objects
    Dim ofd As FileDialog
    Dim initDir As String
    Dim OldSourcePath As String, NewSourcePath As String

    '~~> Excel Objects
    Dim oXLApp As Object, oXLWb As Object

    '~~> Other Variables
    Dim sPath As String, OldPath As String, sFullFileOld As String
    Dim oldFileName As String, newFileName As String

    'Set the initial directory path of File Dialog
    initDir = "C:\"

    '~~> Get the SourceFullName of the chart. It will be something like
    '   C:\MyFile.xlsx!Sheet1![MyFile.xlsx]Sheet1 Chart 1
    OldSourcePath = ActivePresentation.Slides(1).Shapes(1).LinkFormat.SourceFullName

    Set ofd = Application.FileDialog(msoFileDialogFilePicker)

    With ofd
        .InitialFileName = initDir
        .AllowMultiSelect = False

        If .Show = -1 Then
            '~~> Get the path of the newly selected workbook. It will be something like
            '   C:\Book2.xlsx
            sPath = .SelectedItems(1)

            '~~> Launch Excel
            Set oXLApp = CreateObject("Excel.Application")
            oXLApp.Visible = True

            '~~> Open the Excel File. Required to update the chart's source
            Set oXLWb = oXLApp.Workbooks.Open(sPath)

            '~~> Get the path "C:\MyFile.xlsx" from
            '~~> say "C:\MyFile.xlsx!Sheet1![MyFile.xlsx]Sheet1 Chart 1"
            OldPath = Split(OldSourcePath, "!")(0)

            '~~> Get just the filename "MyFile.xlsx"
            oldFileName = GetFilenameFromPath(OldPath)
            '~~> Get just the filename "Book2.xlsx" from the newly
            '~~> Selected file
            newFileName = GetFilenameFromPath(.SelectedItems(1))

            '~~> Replace old file with the new file
            NewSourcePath = Replace(OldSourcePath, oldFileName, newFileName)

            'Debug.Print NewSourcePath

            '~~> Change the source and update
            ActivePresentation.Slides(1).Shapes(1).LinkFormat.SourceFullName = NewSourcePath
            ActivePresentation.Slides(1).Shapes(1).LinkFormat.Update
            DoEvents

            '~~> Close Excel and clean up
            oXLWb.Close (False)

            Set oXLWb = Nothing
            oXLApp.Quit
            Set oXLApp = Nothing
        End If
    End With

    Set ofd = Nothing
End Sub

Public Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = _
        GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function