Powerpoint中来自不同目录下相同工作簿的更新链接(通过vba?)

Question

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

因此，简而言之，我想更新ppt，但是选择一个不同的工作簿(具有不同的目录)。该工作簿在结构上将与旧的工作簿相同，只是有不同的数据。

我知道有方法updatelinks，但是似乎没有任何方法可以用这个方法选择不同的目录。有人有小费吗？

Answer 1

因此，简而言之，我想更新ppt，但是选择了一个不同的工作簿(具有不同的目录)。此工作簿在结构上将与旧工作簿相同，只是数据不同。

在MS 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