パワポ マクロでグラフのリンク更新 LinkFormat.SourceFullNameにFile名セット後LinkFormat.Update

パワポのグラフ元が毎日更新されるエクセルBook
0901.xlsx,0902.xlsx...で
日付別に日々bookが作成される。
パワーポイントのグラフリンク(bookを指定)を更新したい。
とあったので、探ってみました。

知恵袋の質問・キッカケ
detail.chiebukuro.yahoo.co.jp

PowerPointグラフの
Shape.LinkFormat.SourceFullName
を更新するとできるみたいです
LinkFormat.SourceFullName をググって見てください。

いつもの あのあの イライラ解説です※今回は特に、操作ミスが多くイライラします。
www.youtube.com
https://www.youtube.com/watch?v=3MNNTh6K4Oc
目次
00:00 0.やりたいこと
00:45 単体テスト グラフ判断 LinkFormat.SourceFullNameで更新
05:40 2.パワポ基準でエクセルを更新する
07:04 一日の作業 流れをテスト確認
12:11 3.エクセル側にVBA マクロを記載する
15:08 Excel側マクロの説明
18:50 4.更新用 デイリーマクロ作成
20:54 日課の開始
22:25 マクロの説明

---

0.やりたいこと
知恵袋の質問に
毎日更新するブックでパワポのグラフを更新したい(リンク更新したい)
とあったので、探ってみました。

PowerPointでExcelから貼り付けたグラフを更新したい。
ただの更新なら、更新ボタンを押せばいいのですが、
book0907.xlsx から book0908.xlsx など、
ファイルが毎日変わるパターンで

---

1.シェイプの.HasChart でグラフ判断 LinkFormat.SourceFullNameで更新

探ってみると、同型のグラフなら(同型フォーマットはあたりまえか・・・)
LinkFormat.SourceFullName = "パス+ファイル名 d:\data\aaa.xls など"
を更新するとできるみたいです。

デバッグ、テスト実行してみる

'アクティブなスライドの
'グラフリンク元を取得後、　
'InputBoxで簡易変更してみる。
Sub アクティブスライド内でグラフリンク先を更新()

    Dim sld As Slide
    Dim n As Integer
    
    '現在のスライド
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    Set sld = ActivePresentation.Slides(n)

    Dim shp As Shape     'シェイプ
    Dim oChart As Chart  'チャート、グラフ
    
    Set oChart = Nothing '初期化
    For Each shp In sld.Shapes '図形やテキスト、シェイプの中からグラフを探す
        '.HasChart で判断
        If shp.HasChart = msoTrue Then 'グラフなら
            Set oChart = shp.Chart  'チャートをセット
            Exit For  'ループを抜ける、グラフ二つは考えない、ぉぃぉぃ
        End If
    Next
    
    If oChart Is Nothing Then  'Nothingのままなら
        MsgBox "グラフが見つかりません"
        Exit Sub
    End If

    '念のため、.IsLinked リンクか聞く
    If oChart.ChartData.IsLinked = True Then
        Dim sLINKMOTO As String  'リンク元
        sLINKMOTO = shp.LinkFormat.SourceFullName
        
        'InputBoxで入力、現在の値sLINKMOTOをデフォルト、自分で書き換える
        Dim sUPDATEFILE As String    '更新ファイル名
        sUPDATEFILE = InputBox("更新ファイル名を入力", "ファイル名入力", sLINKMOTO)
        
        '↑名前を変更しなかったら。※そのままエンターもあり
        If sLINKMOTO = sUPDATEFILE Then
            MsgBox "同じファイル名です、確認してね", vbQuestion
            Exit Sub
        End If
        
        '↑キャンセルもあるので、チェック
        If Len("" & Trim(sUPDATEFILE)) = 0 Then
            MsgBox "リンク更新をキャンセルしました", vbInformation
            Exit Sub
        End If
        
        'shp.LinkFormat.SourceFullNameにセットすると、更新される
        shp.LinkFormat.SourceFullName = sUPDATEFILE
        shp.LinkFormat.Update 'shp.LinkFormat.Updateも忘れないでね ""
    End If
    
    MsgBox "グラフが更新されました、確認してください"

End Sub

---

2.パワポ基準でエクセルを更新する

パワポにマクロを仕込みます。
※プレゼン.pptmとマクロ付きのパワポファイルにします。

下記のソースを仕込みます。

'※後ろから4桁をmmddに当日自動セットぐらいはやってもいいかな。
'アクティブなスライドの
'グラフリンク元を取得後、
'InputBoxで簡易変更してみる。
Sub アクティブスライド内でグラフリンク先を更新_当日mmddデフォルト()

    Dim sld As Slide
    Dim n As Integer
    
    '現在のスライド
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    Set sld = ActivePresentation.Slides(n)

    Dim shp As Shape     'シェイプ
    Dim oChart As Chart  'チャート、グラフ
    
    Set oChart = Nothing '初期化
    For Each shp In sld.Shapes '図形やテキスト、シェイプの中からグラフを探す
        '.HasChart で判断
        If shp.HasChart = msoTrue Then 'グラフなら
            Set oChart = shp.Chart  'チャートをセット
            Exit For  'ループを抜ける、グラフ二つは考えない、ぉぃぉぃ
        End If
    Next
    
    If oChart Is Nothing Then  'Nothingのままなら
        MsgBox "グラフが見つかりません"
        Exit Sub
    End If

    '念のため、.IsLinked リンクか聞く
    If oChart.ChartData.IsLinked = True Then
        Dim sLINKMOTO As String  'リンク元
        sLINKMOTO = shp.LinkFormat.SourceFullName
        '↑のファイルが x:\xxx\xxx\XXXX0908.xlsx とすると、後ろの4桁mmddを当日にする
        Dim sMMDD As String
        sMMDD = Format(Date, "mmdd")
        Dim nCNT As Integer
        nCNT = Len(sLINKMOTO) 'リンク元の文字数を数える
        sLINKMOTO = Left(sLINKMOTO, nCNT - 9) & sMMDD & ".xlsx"
        '↑左側の9文字分切り取り MMDDと".xlsx" をプラスする

        'InputBoxで入力、現在の値sLINKMOTOをデフォルト、自分で書き換える
        Dim sUPDATEFILE As String    '更新ファイル名
        sUPDATEFILE = InputBox("更新ファイル名を入力", "ファイル名入力", sLINKMOTO)
        
        '↑キャンセルもあるので、チェック
        If Len("" & Trim(sUPDATEFILE)) = 0 Then
            MsgBox "リンク更新をキャンセルしました", vbInformation
            Exit Sub
        End If
        
        'shp.LinkFormat.SourceFullNameにセットすると、更新される
        shp.LinkFormat.SourceFullName = sUPDATEFILE
        shp.LinkFormat.Update 'shp.LinkFormat.Updateも忘れないでね ""
    End If
    
    MsgBox "グラフが更新されました、確認してください"

End Sub

2.1 実践、実験してみる
一日の流れ、
2.1.1 ファイルのコピー、リネーム
2.1.2 Excelでデータ入力、集計、グラフが更新される
2.1.3 プレゼン.pptm を開き、リンク先の更新
※もしかして、パワポも日付別なのかなあ？それもテストする

---

休憩、視聴者の心の声:
「やっぱり、おじさんって、事務処理のセンスないよね？」
「Excelファイルにデータ入力後、グラフを更新するんだから、
　パワポ基準じゃなくて、Excel入力後にマクロでパワポの方(グラフ)を操作すればいいのにね」

そっか、そうだよね、それが自然な流れかなぁ。・・・

って、ことで、Excel側のマクロから、パワポプレゼンを操作してみます。

---

3.エクセル側にVBA マクロを記載する
自分自身のグラフ・・・と、エクセル側の方で、わかっているので、
今度は、Excelにマクロを登録します

Sub TEST自分の名前と場所はわかるので()

    Debug.Print ".Path=" & ActiveWorkbook.Path
    Debug.Print ".Name=" & ActiveWorkbook.Name
    Debug.Print ".FullName=" & ActiveWorkbook.FullName

End Sub

'アクティブなパワポを捕まえて、
'そのスライド内のグラフリンクを
'このブックにする
Sub Excelから開いているパワポに対してグラフのリンク更新()

    Dim ppApp As Object   'PowerPoint.Application

    On Error Resume Next  '取得エラー時に次へ
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意

    If ppApp Is Nothing Then  '上↑で、パワポアプリを受け取れなかったら
        MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね"
        Exit Sub
    End If


    Dim objSLIDE As Object 'PowerPoint.Slide
    Dim objShape As Object 'PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか
    Dim objCHART As Object 'PowerPoint Shape Chart ※グラフ
    
    For Each objSLIDE In ppApp.ActivePresentation.Slides 'スライドのループ
        For Each objShape In objSLIDE.Shapes '図形やテキスト、シェイプの中からグラフを探す
            '.HasChart で判断
            If objShape.HasChart = msoTrue Then 'グラフなら
                Set objCHART = objShape.Chart  'チャートをセット
                '念のため、.IsLinked リンクか聞く
                If objCHART.ChartData.IsLinked = True Then
                    'ここで、リンクをセット ThisWorkbook.FullNameが自分自身のなまえだった・・
                    objShape.LinkFormat.SourceFullName = ThisWorkbook.FullName
                    objShape.LinkFormat.Update '.LinkFormat.Updateも忘れないでね
                End If
                Exit For  'ループを抜ける、グラフ二つは考えない、ぉぃぉぃ
            End If
        Next
    Next

    MsgBox "処理終了、パワポのスライドを確認してください"

End Sub

一日の流れ、
3.1.1 ファイルのコピー、リネーム
3.1.2 Excelでデータ入力、集計、グラフが更新される
3.1.3 プレゼン.pptx マクロ無しのパワポを開く
3.1.4 Excelでアクティブなパワポを修正するマクロを実行する

※もしかして、パワポも日付別なのかなあ？それもテストする

---

4.どっちでも、日々、マクロ付きエクセル・パワポが増えていき、なんかいやだなぁ。

視聴者心の声:「日々のデータファイルに同じマクロがついていると嫌われるよ」

そうですよねぇ、なんかしっくりこないし。

4.1 更新用、デイリークエスト.xlsmと一つマクロ付きブックを作る。

B4などに、Excelブックのフルパスを記入

↑このパスを利用して、3.1.4のように、アクティブなパワポを修正する？

Option Explicit

'アクティブなパワポを捕まえて、
'そのスライド内のグラフリンクを
'B4のPATH + B6のブック名にする
Sub Excelから開いているパワポに対してグラフのリンク更新2()

    Dim sXLSNAME As String  'B4+B6のリンク更新するファイル名
    
    sXLSNAME = Range("B4") & Range("B6")
    If Dir(sXLSNAME) = "" Then
        MsgBox sXLSNAME & "が見つかりません", vbExclamation
        Exit Sub
    End If

    Dim ppApp As Object   'PowerPoint.Application

    On Error Resume Next  '取得エラー時に次へ
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0  'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意

    If ppApp Is Nothing Then  '上↑で、パワポアプリを受け取れなかったら
        MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね"
        Exit Sub
    End If


    Dim objSLIDE As Object 'PowerPoint.Slide
    Dim objShape As Object 'PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか
    Dim objCHART As Object 'PowerPoint Shape Chart ※グラフ
    
    For Each objSLIDE In ppApp.ActivePresentation.Slides 'スライドのループ
        For Each objShape In objSLIDE.Shapes '図形やテキスト、シェイプの中からグラフを探す
            '.HasChart で判断
            If objShape.HasChart = msoTrue Then 'グラフなら
                Set objCHART = objShape.Chart  'チャートをセット
                '念のため、.IsLinked リンクか聞く
                If objCHART.ChartData.IsLinked = True Then
                    'ここで、リンクをセット B4+B6のファイル名をセットする
                    objShape.LinkFormat.SourceFullName = sXLSNAME
                    objShape.LinkFormat.Update '.LinkFormat.Updateも忘れないでね
                End If
                Exit For  'ループを抜ける、グラフ二つは考えない、ぉぃぉぃ
            End If
        Next
    Next

    MsgBox "処理終了、パワポのスライドを確認してください"

End Sub

一日の流れ、
4.1.1 ファイルのコピー、リネーム
4.1.2 Excelでデータ入力、集計、グラフが更新される
4.1.3 プレゼン.pptx マクロ無しのパワポを開く※グラフを更新したいパワポを開く
4.1.4
a.デイリークエスト.xlsmを開く
b.B4などのパス・ファイル名を修正
c.パワポ更新のマクロを実行

などなど、いろいろと、やり方があったり。

ここまでやると、
おじさんの事務処理能力、設計力の無さ
が、わかってきたり・・・ぉぃぉぃ。

流れを整理すると、
ミスのない作業(更新忘れ)
や
スムーズな業務の流れになると思います。

長々、書きましたが、説明しましたが、

探ってみると、グラフの
LinkFormat.SourceFullName
を更新するとできるみたいです

上記３行でしたね。ぉぃぉぃ。

解決のヒントとなれば幸いです。

---

今回のグラフのほかに、Excel表のリンクを更新した作業例
関連記事を書きました。表のリンクは下記を見てください。
ken3memo.hatenablog.com