パワポのデバッグ・確認資料として、ハイパーリンクの一覧を作成したく、
ハイパーリンクのオブジェクトを探るが、
しっくりこなかったお話です。
知恵袋の質問
detail.chiebukuro.yahoo.co.jp
の回答用に作成する、他の回答者がシンプルなコードを先にUPしているのでそちらも参考にしてみてください。
下記、いつもの あのあの そのその 解説動画です。参考程度に聞き流してください。
www.youtube.com
https://www.youtube.com/watch?v=t_qd3K2jhcw
目次
00:00 1.Slideの下に.Hyperlinks
04:29 2.Excelのシートに書き込んでみた
07:52 3.やってみて、いまいちの理由
1.Slideの下に.Hyperlinksがあったので、１つ１つプロパティを表示してみた
スライドの下に、
Hyperlinksでハイパーリンクのオブジェクトがまとまっていたので、
ここから、探ってみた。
'スライド内のハイパーリンクを探る 'ActivePresentation.Slides(2).Hyperlinks Sub Hyperlinkのプロパティをテスト表示20220603() Dim objSLIDE As PowerPoint.Slide Set objSLIDE = ActivePresentation.Slides(2) 'テストで2ページ目 Dim objHL As PowerPoint.Hyperlink For Each objHL In objSLIDE.Hyperlinks On Error Resume Next '動作ボタン・図形など テキストなしの時エラーになるので無視する Debug.Print ".TextToDisplay: " & objHL.TextToDisplay Debug.Print ".Address: " & objHL.Address Debug.Print ".EmailSubject: " & objHL.EmailSubject Debug.Print ".SubAddress: " & objHL.SubAddress Debug.Print ".ScreenTip: " & objHL.ScreenTip Debug.Print ".Type: " & objHL.Type On Error GoTo 0 '元に戻す 他に影響ないように エラートラップを戻す Next Stop '確認で止める、デバッグ用 End Sub
2.Excelのシートに書き込んでみた
Option Explicit Sub Excelで起動済みパワポからハイパーリンク取得20220603() 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 'Sheets.Add After:=ActiveSheet 'シートを新規で追加するのもアリ？お任せします Cells.ClearContents 'アクティブシートを※勝手に全クリアして書き込むので※※注意 Dim r As Range '左上の場所 Set r = Range("A1") 'A1からにする '見出しを書き込む r.Offset(0, 0) = "Page番号" r.Offset(0, 1) = ".TextToDisplay" r.Offset(0, 2) = ".Address" r.Offset(0, 3) = ".EmailSubject" r.Offset(0, 4) = ".SubAddress" r.Offset(0, 5) = ".ScreenTip" r.Offset(0, 6) = ".Type" Dim p As Integer, y As Integer 'pp:スライドページ Excel:y行 Dim objShape As Object 'PowerPoint.Shape 'パワポのシェイプ、テキスト、図形ほか Dim objSLIDE As Object 'PowerPoint.Slide Dim objHL As Object 'PowerPoint.Hyperlink y = 1 'Excel側の行管理 p = 1 'pp側:スライド番号 For Each objSLIDE In ppApp.ActivePresentation.Slides 'スライドのループ For Each objHL In objSLIDE.Hyperlinks r.Offset(y, 0) = p 'スライド番号セット On Error Resume Next '動作ボタン・図形など テキストなしの時エラーになるので無視する r.Offset(y, 1) = objHL.TextToDisplay r.Offset(y, 2) = objHL.Address r.Offset(y, 3) = objHL.EmailSubject r.Offset(y, 4) = objHL.SubAddress r.Offset(y, 5) = objHL.ScreenTip r.Offset(y, 6) = objHL.Type On Error GoTo 0 '元に戻す 他に影響ないように エラートラップを戻す y = y + 1 'Excelのセット位置、行を増やす Next p = p + 1 'スライド番号 Next '最後に列幅の自動調整 文字数が多いなら、やらない方がいいな Columns("A:G").EntireColumn.AutoFit MsgBox "処理終了" End Sub
↑の結果↓
3.やってみて、いまいちの理由
パワポ側のオブジェクト名が知りたいと、個人的には思ったり・・・
スライド下の
ActivePresentation.Slides(2).Hyperlinks
から、リンクを取り出しているが、
この図形、このテキストボックスのリンクがわからなかった。
※正確には、シェイプの下にアクションがあるが、
ここから探る方法がわからなかった、
勉強不足、力不足です・・・
PP側のテストプログラム、
STOPで止めて、
ウォッチ式でスライドの中を見せる
- : Shapes : : Shapes/Shapes : Module1.Hyperlinkのプロパティをテスト表示20220603
ITEM3によさそうなものがある
- : Item 3 : : Variant/Object/Shape : Module1.Hyperlinkのプロパティをテスト表示20220603
- : ActionSettings : : ActionSettings/ActionSettings : Module1.Hyperlinkのプロパティをテスト表示20220603
ActionSettings これが、あやしくて、
この下に、アクションのITEMがあり、
- : Item 1 : : Variant/Object/ActionSetting : Module1.Hyperlinkのプロパティをテスト表示20220603
- : Hyperlink : : Hyperlink/Hyperlink : Module1.Hyperlinkのプロパティをテスト表示20220603
: SubAddress : "-1,-1,PREV" : String : Module1.Hyperlinkのプロパティをテスト表示20220603
やった、これですね。
と、安心するも、
プレースフォルダにまとめられた、
文字列に、複数、ハイパーリンクが貼ってあるとき、
※ITEM2 の ように、箇条書きテキストに１行、１行、貼ってあったときなど、
取得方法がわからなかった。
: Text : "文字列先頭ページを設定にハイパーリンクを設定する
Google検索 webページのアドレスをハイパーリンクにする
メルアド メールアドレスをハイパーリンク
ZZZZZZZ
勉強不足です。
出直してきます。 ぉぃぉぃ。
以上、いつものように脱線しましたが、
スライドの下にまとめられた、ハイパーリンクをエクセルへ出力してみたテストでした。
Shapes の下から、探る方法、勉強しないとなぁ・・・・
