Excelのシートをリンクして作成しているプレゼンがあります
そのExcelシートのリンク情報・リンク先を
VBAマクロで更新する。
youtu.be
https://youtu.be/wnhVcYHxXXQ
目次
00:00 0.やりたいこと Excelリンク貼り付けのシートを更新したい
02:25 1.まずは、リンク情報の確認 LinkFormat.SourceFullName
05:42 2.リンク情報 LinkFormat.SourceFullName を書き換える
08:52 3.存在しないシート名を設定したら・・・
13:00 4.おわりの挨拶 当て逃げ・・・
0.やりたいこと Excelリンク貼り付けのシートを更新したい
Excelのシートをリンクして作成しているスライドがあります
そのリンク情報・リンク先をVBAマクロで更新してみたいです。
リンク D:\チーム共通\受注予定.xlsx!5月!R3C2:R9C4
を
リンク D:\チーム共通\受注予定.xlsx!6月!R3C2:R9C4
みたいに、次の月に更新したい。
キッカケは、
detail.chiebukuro.yahoo.co.jp
の質問です。↑少し、やっていることが違うけど・・・
1.まずは、リンク情報の確認 LinkFormat.SourceFullName
リンク情報の確認をパワポでしてみたいと思います。
昔書いた、手前みそコード
https://www.youtube.com/watch?v=OBDI3ZnKZoE&t=2312s
を修正してみます。
ポイントは、
Shape.LinkFormat.SourceFullName
にリンク先が保存されています。
リンクされたシェイプのオブジェクト以外だと
エラーが発生するので、
そのエラーを利用しています。
'ここからPointPointマクロに貼り実行する Sub pp_test20230521リンク情報をイミディエイトへ() Dim objSLIDE As PowerPoint.Slide 'スライド Dim objShape As PowerPoint.Shape 'シェイプ、テキスト、図形ほか Dim strLINK As String 'リンク文字列、エラーチェックも兼ねて使用 Dim nPAGE As Integer 'アクティブなパワポのスライド全てをあさる。 Debug.Print "スライド番号", "objShape.Name", "リンク先" nPAGE = 0 For Each objSLIDE In ActivePresentation.Slides 'スライドのループ nPAGE = nPAGE + 1 For Each objShape In objSLIDE.Shapes 'シェイプを一つ一つ調べたいので 'LinkFormat.SourceFullName で判断 strLINK = "エラーです" 'エラーで初期化 On Error Resume Next '取得エラー時でも次へ、ぶつかっても無視する strLINK = objShape.LinkFormat.SourceFullName 'リンク先、箱の中身を取り出す? On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 '↑のエラーを判断 箱の中身LinkFormat.SourceFullNameから取り出せたら If strLINK <> "エラーです" Then 'リンクアリのシェイプなら Debug.Print nPAGE, objShape.Name, strLINK End If Next Next MsgBox "処理終了、イミディエイトを確認してください" End Sub '↑ここまでをコピー
イミディエイト結果:
スライド番号 objShape.Name リンク先
4 Object 2 D:\チーム共通\受注予定.xlsx!5月!R3C2:R9C4
5 Object 2 D:\チーム共通\連絡事項.xlsx!5月!R3C2:R9C3
2.リンク情報 LinkFormat.SourceFullName を書き換える
次は、リンク情報を書き換えてみたいと思います。
と言っても、
LinkFormat.SourceFullName に 値を入れて、
忘れずに更新
LinkFormat.Update '.LinkFormat.Updateも忘れないでね
するだけです。
'ここからPointPointマクロに貼り実行する Sub pp_test0521リンク情報を書き換えるシート名でテスト() Dim objSLIDE As PowerPoint.Slide 'スライド Dim objShape As PowerPoint.Shape 'シェイプ、テキスト、図形ほか Dim strLINK As String 'リンク文字列、エラーチェックも兼ねて使用 Dim nPAGE As Integer 'テスト用 シート名 !を入れたのは、1月と11月がひっかかる予防も兼ねて Const MotoShName = "!4月!" '書き換え元 Const SakiShName = "!5月!" '置換先 'アクティブなパワポのスライド全てをあさる。 Debug.Print "スライド番号", "objShape.Name", "リンク先" nPAGE = 0 For Each objSLIDE In ActivePresentation.Slides 'スライドのループ nPAGE = nPAGE + 1 For Each objShape In objSLIDE.Shapes 'シェイプを一つ一つ調べたいので 'LinkFormat.SourceFullName で判断 strLINK = "エラーです" 'エラーで初期化 On Error Resume Next '取得エラー時でも次へ、ぶつかっても無視する strLINK = objShape.LinkFormat.SourceFullName 'リンク先、箱の中身を取り出す? On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 '↑のエラーを判断 箱の中身LinkFormat.SourceFullNameから取り出せたら If strLINK <> "エラーです" Then 'リンクアリのシェイプなら Debug.Print nPAGE, objShape.Name, strLINK '置換元のシート名が存在するか 文字列を探して判断 If InStr(strLINK, MotoShName) > 0 Then '見つかったら strLINK = Replace(strLINK, MotoShName, SakiShName) '単純に置き換える objShape.LinkFormat.SourceFullName = strLINK '↑で置換したリンク先をセットする '更新もついでに objShape.LinkFormat.Update '更新する Debug.Print strLINK & "に更新。確認してください" End If End If Next Next MsgBox "処理終了、更新されたか確認してください" End Sub '↑ここまでをコピー
3.存在しないシート名を設定したら・・・
D:\チーム共通\受注予定.xlsx!5月!R3C2:R9C4
を
D:\チーム共通\受注予定.xlsx!7月!R3C2:R9C4
など、
7月や8月、用意されていないシート名を指定してリンクを更新実行すると・・・
なんと、
エラーが発生してくれればいいのに、
ここは、なんか気を利かせて、
シート名を抜かした、ブック全体のリンクになった・・・
D:\チーム共通\受注予定.xlsx
これは、これで、問題かなぁ・・・
※正常終了ではないのに、これだと気が付かない。
※※それに、自動保存されたら、設定した範囲が行方不明となり・・・
やはり、先に進入禁止、進ませないなど、
エラーチェックする必要もありますね。
さっきまで、ぶつかってから(エラーを発生させてから)
処理しよう とか 力説 してたのに、恥ずかしいね・・・
4.おわりの挨拶 当て逃げ・・・
えっ、進入禁止、エラーチェックしないの・・・
とりあえず、
Shape.LinkFormat.SourceFullName
を探る、動画ってことで・・・
リンク更新処理の参考となれば幸いです。
※事故処理しないで、逃げるのかよ。当て逃げ良くないぞ・・・
エラーを発生させながら、
ぶつけながら進んで行くイメージ・・・例えが悪いけど・・・
画像イメージ作成:
車の様子。ぶつけられてヘコんだ車が二台。当て逃げして逃げる車。
車止め。進入禁止。
ゲームを行う様子。
チャレンジャーは箱の中に手を入れ触りながら見えない物体の名前を当てるゲーム。
観客側からは透明で正解が見えています。
A game being played.
Challenger is a game in which the player guesses the name of an invisible object by putting his or her hand
inside a box and touching it.
The correct answer is transparent to the audience.
↑変数、箱の中身に手を入れて、エラーを含め処理する説明のイメージで使う予定が・・・