三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

PowerPoint VBA ハイパーリンクを探る ExcelからパワポのHyperlinkを取得するマクロ


パワポデバッグ・確認資料として、ハイパーリンクの一覧を作成したく、
ハイパーリンクのオブジェクトを探るが、
しっくりこなかったお話です。

知恵袋の質問
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があったので、1つ1つプロパティを表示してみた

スライドの下に、
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 の ように、箇条書きテキストに1行、1行、貼ってあったときなど、
取得方法がわからなかった。

: Text : "文字列先頭ページを設定にハイパーリンクを設定する
Google検索 webページのアドレスをハイパーリンクにする
メルアド メールアドレスをハイパーリンク
ZZZZZZZ

勉強不足です。
出直してきます。 ぉぃぉぃ。

以上、いつものように脱線しましたが、
スライドの下にまとめられた、ハイパーリンクをエクセルへ出力してみたテストでした。

Shapes の下から、探る方法、勉強しないとなぁ・・・・

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)