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

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

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


PowerPoint2003のマクロ記録でパワーポイントのスライド追加とタイトル代入

VBAのプロパティやメソッドを探る時、
マクロ記録を使う方法
そんなお話をダラダラ撮った動画
youtu.be
https://youtu.be/dENBobeb5lY
です。

プログラム作成の参考となれば幸いです。

はてなの質問
q.hatena.ne.jp
の回答用に作成したコードと動画です。

下記、動画で記録されたコードとテストで使ったコードです

Sub Macro1()
'
' マクロ記録日: 2019/11/1 ユーザー名: Ken3           O
'

    ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
    With ActiveWindow.Selection.TextRange
        .Text = "aaaa"
        With .Font
            .NameAscii = "Arial"
            .NameFarEast = "MS Pゴシック"
            .NameOther = "Arial"
            .Size = 44
            .Bold = msoFalse
            .Italic = msoFalse
            .Underline = msoFalse
            .Shadow = msoFalse
            .Emboss = msoFalse
            .BaselineOffset = 0
            .AutoRotateNumbers = msoTrue
            .Color.SchemeColor = ppTitle
        End With
    End With
    ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
    With ActiveWindow.Selection.TextRange
        .Text = "bbbb"
        With .Font
            .NameAscii = "Arial"
            .NameFarEast = "MS Pゴシック"
            .NameOther = "Arial"
            .Size = 32
            .Bold = msoFalse
            .Italic = msoFalse
            .Underline = msoFalse
            .Shadow = msoFalse
            .Emboss = msoFalse
            .BaselineOffset = 0
            .AutoRotateNumbers = msoTrue
            .Color.SchemeColor = ppForeground
        End With
    End With
    ActiveWindow.Selection.Unselect
End Sub
Sub Macro2()
'
' マクロ記録日: 2019/11/1 ユーザー名: Ken3           O
'

    ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutText).SlideIndex
    ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
    With ActiveWindow.Selection.TextRange
        .Text = "aaaaaaa"
        With .Font
            .NameAscii = "Arial"
            .NameFarEast = "MS Pゴシック"
            .NameOther = "Arial"
            .Size = 44
            .Bold = msoFalse
            .Italic = msoFalse
            .Underline = msoFalse
            .Shadow = msoFalse
            .Emboss = msoFalse
            .BaselineOffset = 0
            .AutoRotateNumbers = msoTrue
            .Color.SchemeColor = ppTitle
        End With
    End With
    ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
    With ActiveWindow.Selection.TextRange
        .Text = "zzzz" + Chr$(CharCode:=13) + "xxxx" + Chr$(CharCode:=13)
        With .Font
            .NameAscii = "Arial"
            .NameFarEast = "MS Pゴシック"
            .NameOther = "Arial"
            .Size = 32
            .Bold = msoFalse
            .Italic = msoFalse
            .Underline = msoFalse
            .Shadow = msoFalse
            .Emboss = msoFalse
            .BaselineOffset = 0
            .AutoRotateNumbers = msoTrue
            .Color.SchemeColor = ppForeground
        End With
    End With
End Sub

Sub test()

    Dim n As Integer

    '新規プレゼンのファイル作成
    Presentations.Add WithWindow:=msoTrue
    
    'スライドの数
    n = ActivePresentation.Slides.Count + 1
 
    'スライドの追加
    ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=n, Layout:=3).SlideIndex
    'タイトル 一番目のオブジェクトにテキストセット
    ActiveWindow.Selection.SlideRange.Shapes(1).TextFrame.TextRange.Text = "Ken3 TEST999そそそ"

    'スライドの数
    n = ActivePresentation.Slides.Count + 1
 
    'スライドの追加
    ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=n, Layout:=3).SlideIndex
    'タイトル 一番目のオブジェクトにテキストセット
    ActiveWindow.Selection.SlideRange.Shapes(1).TextFrame.TextRange.Text = "page 2"

End Sub
Sub Macro3()
'
' マクロ記録日: 2019/11/1 ユーザー名: Ken3           O
'

    ActivePresentation.Slides.Add(Index:=7, Layout:=ppLayoutTitleOnly).Select
    ActiveWindow.Selection.SlideRange.Layout = ppLayoutTwoColumnText
    ActivePresentation.Slides.Add(Index:=8, Layout:=ppLayoutTwoColumnText).Select
End Sub
Sub Macro4()
'
' マクロ記録日: 2019/11/1 ユーザー名: Ken3           O
'

    Presentations.Add WithWindow:=msoTrue
    ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutTitle).SlideIndex
End Sub

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


Ken3 ホームページ 目次

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

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

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