0

パワーポイント (ppt) スライドのグラフを Excel (xls) ワークブックのグラフにリンクする作業を行っています。特殊な貼り付けを使用してリンクを作成するだけなので、これは vba コードがなくても問題なく機能します。ただし、ppt は古いディレクトリの xls からデータを更新しようとするため、ppt と xls のディレクトリを変更すると問題が発生します。ただし、私の目標はこれらのファイルを共有することです。そのため、誰もが ppt を xls で更新できます。

つまり、簡単に言えば、ppt を更新したいのですが、別のワークブック (別のディレクトリ) を選択します。このワークブックは、データが異なるだけで、構造的には古いワークブックと同じです。

メソッド updatelinks があることは知っていますが、このメソッドで別のディレクトリを選択する方法はないようです。誰にもヒントはありますか？

4

1 に答える 1

0

つまり、簡単に言えば、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
于 2013-11-15T11:09:19.663 に答える