三流君のソースコード置き場

ブログにソースコードをアップして、ブログの検索機能で利用してます(利用予定です)

よく検索されるキーワード: [VBA]/ [VBS]/ [CreateObject]/ [Excel]/ [ADO]


ActivePresentation.Slides(1).Copy スライドの1ページ目をコピー

データ転記でページが足りない時、
'スライドを増やす
ppApp.ActivePresentation.Slides(1).Copy '1ページ目をコピー
ppApp.ActivePresentation.Slides.Paste p '最終スライドpageに貼り付け
で、1ページ目をコピーしました。

    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

デバッグ動画 は 11:00 あたりでスライドのコピーを行ってます。
youtu.be
https://youtu.be/-qPCSgPQuSw?t=653

#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 データ転記処理のヒントとなれば幸いです。



ken3memo.hatenablog.com

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
(※詳細は[三流君 三流プログラマーとは?]を見てください)


Ken3 ホームページ 目次

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

三流解説動画の再生リスト
https://www.youtube.com/user/ken3video/playlists

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