Powerpoint中的相同工作簿中的更新鏈接（通過vba？）

Question

我正在將powerpoint（ppt）幻燈片中的圖表鏈接到Excel（xls）工作簿中的圖表。這工作正常，沒有vba代碼，因爲我只是使用粘貼專用來創建鏈接。但是，當我更改ppt的directoy以及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