三流君 ken3のmemo置き場

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

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

ExcelからPowerPointへ 項目名が同じ名前のオブジェクトにデータをセットする

タイトルとサムネイル

下記、知恵袋の質問に触発され
detail.chiebukuro.yahoo.co.jp
ExcelのデータをPowerPointに転記する
そんな処理をやってみます。

勝手に作った仕様は、
Excel:A1一行目~項目名 2行目からデータ
pp:図やテキストボックスに名前を付け、その場所にセットする

Excel1行目の項目名
PowerPoint同じ名前のオブジェクト
にデータをセットします

そんなラフなイメージです。

下記、いつもの あのあの そのその 解説とデバッグ動画です
youtu.be
https://youtu.be/-qPCSgPQuSw

#ExcelVBA #PowerPointVBA #マクロ #自動転記 #デバッグ

Excelからパワポにデータをセットしてみました。
Excelのソース ※パワポを開いた状態でテストしてみてください

Option Explicit

Sub Excelから起動済みのパワポにデータセット20220425()

    '起動済みのパワポを捕まえる
    Dim ppApp As Object
    
    Set ppApp = Nothing
    On Error Resume Next  'エラーが発生しても強引に次の命令に行け
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0  '忘れないで戻すぞ

    If ppApp Is Nothing Then
        MsgBox "セット用のパワポを開いてから、再テストしてね"
        Exit Sub
    End If
    
    'データをセットする
    Dim r As Range   'Excel 左上
    
    Set r = Range("A1")  'A1からテストで始める
    
    Dim p As Integer  'Excel側:行カウンタ pp:セットするページ
    Dim x As Integer  'Excel 列カウンタ、
    Dim str転記列名 As String  'Excel:転記列名 pp:セットするオブジェクト名
    Dim ppObjShape As Object 'ppセットするオブジェクト
    
    p = 1
    While Len(Trim("" & r.Offset(p, 0))) <> 0  '左端にデータがある間ループ
        'ppのセットページがなかったら、1ページを最終にコピー
        If p > ppApp.ActivePresentation.Slides.Count Then
            'スライドを増やす
            ppApp.ActivePresentation.Slides(1).Copy  '1ページ目をコピー
            ppApp.ActivePresentation.Slides.Paste p  '最終スライドpageに貼り付け
        End If
        
        'pページのスライドにデータをセットする
        For x = 0 To 99  '99までループにして途中でExitするループ
            str転記列名 = Trim("" & r.Offset(0, x)) '0行目のx列、項目名を取得
            If Len(str転記列名) = 0 Then Exit For '転記項目が無くなったら抜ける
            
            'Excelから単純にItem(項目名)でデータセット、エラーを無視して項目名無しを回避
            On Error Resume Next  'エラーが発生しても強引に次の命令に行け
            Set ppObjShape = Nothing  'これが無いと、前回オブジェクトが残る
            Set ppObjShape = ppApp.ActivePresentation.Slides(p).Shapes(str転記列名) 'セットするオブジェクト
            ppObjShape.TextFrame.TextRange.Text = r.Offset(p, x).Text 'Excelから文字列を代入
            On Error GoTo 0  '忘れないで戻すぞ
        Next x
        p = p + 1  '次の位置へ
    Wend

    MsgBox "セット終了"

End Sub

Excel から PowerPoint データ転記処理のヒントとなれば幸いです。

Ken3 ホームページ 目次

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



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