VBAの俳句出力プログラムを、PowerPointに移植してみました。

こんにちはー！ニアです。

前回作成した「WordのVBAで俳句を出力するプログラム」（→ 開発記事）をPowerPoint用に移植してみました。

1. まずはテキストボックスに出力
2. せっかくなのでデコレーションしてみた
3. お好みの俳句を出力
4. おわりに

1. まずはテキストボックスに出力

まず、PowerPointのスライドに縦書きのテキストボックスを追加して、その中に俳句を入れてみます。

Option Explicit

Sub Haiku()
    
    Dim sld As slide
    Dim haikuTb As Object
    
    ' 1番目のスライドを取得します。
    Set sld = ActivePresentation.Slides.Item(1)
    
    ' 俳句用の縦書きテキストボックスを作成します。
    Set haikuTb = sld.Shapes.AddTextbox( _
        msoTextOrientationVerticalFarEast, _
        sld.Master.Width / 2 - 50, 50, _
        180, 360)
    
    ' テキストボックスに文字列とフォントを設定します。
    With haikuTb.TextFrame2.TextRange.Characters
        .Text = "初桜" + vbCrLf + "折しも今日は" + vbCrLf + "よき日なり"
        .Font.NameFarEast = "HGS行書体"
        .Font.Size = "50"
    End With
    
End Sub

9行目のActiveDocument.Slides.Item(1)（Itemを省略してSlidesに直接インデックスを指定してもOK）で1枚目のスライドオブジェクトを取得して、そこからはWordのVBAと同じく、Shapes.AddTextboxでテキストボックスを追加します。もちろん、縦書きにする時は、第1引数をmsoTextOrientationVerticalFarEastに指定します。

スライドの高さや幅を取得したい時は、[スライドオブジェクト].Masterでスライドマスターのオブジェクトを取得して、Height、Widthプロパティを呼び出します。

※スライドマスターとはスライド内部の色や書式、レイアウトを管理している設計図みたいなものです。

あとは、追加したテキストボックスに俳句を設定するのですが、Wordと違ってSelection経由からアクセスできないので、代わりに[テキストボックス].TextFrame2.TextRange.Characters経由でアクセスします。

もう1つ気を付けるのが、テキストボックスのフォント設定する時には.Font.Nameでなく、.Font.NameFarEastにフォント名を設定します。.Font.Nameではなぜかフォントが変化しないので・・・。

参考：Excel 2007 のテキストボックスで使用するフォントの種類をマクロで変更できない | Microsoft サポート

この資料ではExcel 2007用のですが、おそらくOffice 2007からテキストボックスの仕様が変わったのかな。

実行すると、こんな感じです。

2. せっかくなのでデコレーションしてみた

これだと、ちょっと寂しいので、スライドをデコレーションしていきます。

Option Explicit

Sub Haiku()
    
    Dim sld As slide
    Dim haikuTb As Object
    Dim autherTb As Object
    Dim i As Integer
    
    ' 1番目のスライドを取得します。
    Set sld = ActivePresentation.Slides.Item(1)
    
    ' そのスライド内の図形を全て削除します。
    If sld.Shapes.Count > 0 Then
        For i = 1 To sld.Shapes.Count
            sld.Shapes(1).Delete
        Next
    End If

    ' スライドレイアウトを「白紙」にし、背景のスタイルを黒地にします。
    With sld
        .Layout = ppLayoutBlank
        .BackgroundStyle = msoBackgroundStylePreset4
    End With
    
    ' 背景画像「定式幕」を追加します。
    ' ActivePresentation.Pathはこのプレゼンテーションファイルのディレクトリを表しています。
    ' あらかじめ、定式幕.pngをこのプレゼンテーションファイルと同じディレクトリに配置しておきます。
    sld.Shapes.AddPicture(ActivePresentation.Path + "\定式幕.png", msoFalse, msoTrue, 0, 0).Select
    
    ' 俳句用の縦書きテキストボックスを作成します。
    Set haikuTb = sld.Shapes.AddTextbox( _
        msoTextOrientationVerticalFarEast, _
        sld.Master.Width / 2 - 50, 50, _
        180, 360)
    
    ' テキストボックスに文字列とフォントを設定します。
    With haikuTb.TextFrame2.TextRange.Characters
        .Text = "初桜" + vbCrLf + "折しも今日は" + vbCrLf + "よき日なり"
        .Font.NameFarEast = "HGS行書体"
        .Font.Size = "50"
    End With
        
    ' 作者用の縦書きのテキストボックスを作成します。
    Set autherTb = sld.Shapes.AddTextbox( _
        msoTextOrientationVerticalFarEast, _
        sld.Master.Width / 2 - 150, 300, _
        60, 180)
        
    ' テキストボックスに文字列とフォントを設定します。
    With autherTb.TextFrame2.TextRange.Characters
        .Text = "松尾芭蕉"
        .Font.NameFarEast = "HGS行書体"
        .Font.Size = "30"
        .ParagraphFormat.Alignment = 3      ' 右寄せ（縦書きでは下寄せ）にします。
    End With
    
    ' 図形の背景色を黒色にします。
    For i = 1 To sld.Shapes.Count
        sld.Shapes(i).Fill.ForeColor.SchemeColor = 1
    Next
    
End Sub

※このプログラムは https://gist.github.com/Nia-TN1012/99306aeaa7eabcc24317 で公開されています。

20行目で、[スライドオブジェクト].Layoutに「ppLayoutBlank」を設定します。ppLayiut・・・とはスライドのレイアウトを表していて、「ppLayoutBlank」はコンテンツが何もない白紙、他にタイトルスライドの「ppLayoutTitile」やタイトルとコンテンツの「ppLayoutObject」など色々ありますよ。

21行目では、BackgroundStyleを「msoBackgroundStylePreset4」に設定して、色を黒地・白文字にします。msoBackgroundStylePresetは名前の通り、スライドの背景のスタイルのプリセットを表しています。

24行目では、背景画像を読み込んで、スライドに画像を張り付けていきます。ファイル名は絶対パスで入力する必要があります（相対ファイルではダメでした）。ここでは画像ファイルをあらかじめ現在のプレゼンテーションファイルと同じフォルダに入れておき、ActivePresentation.Pathで現在のプレゼンテーションファイルのディレクトリを取得しています。

なお、Visual Basicではエスケープ文字が「\」でなく、「”」なので、ファイルの区切り文字はそのまま「\」1つで大丈夫ですよ。

このプログラムでは、以下の画像を使用しています。歌舞伎の定式幕風にしてみました。

あとは、テキストボックスを追加して俳句を入れるだけですが、ついでに作者用のテキストボックスも追加してみました。テキストボックス内の文字列を寄せる時は、.ParagraphFormat.Alignmentの値を設定します（1は左寄せ、2は中央、3は右寄せです）。

3. お好みの俳句を出力

前回のHaiku-word3.vbのように、俳句を入力できるユーザーフォームを用意していきたいと思います。

Private Sub Register_Click()
    
    Dim sld As slide
    Dim haikuTb As Object
    Dim autherTb As Object
    Dim i As Integer
    
    ' 1番目のスライドを取得します。
    Set sld = ActivePresentation.Slides.Item(1)
    
    ' そのスライド内の図形を全て削除します。
    If sld.Shapes.Count > 0 Then
        For i = 1 To sld.Shapes.Count
            sld.Shapes(1).Delete
        Next
    End If
    
    ' スライドレイアウトを「白紙」にし、背景のスタイルを黒地にします。
    With sld
        .Layout = ppLayoutBlank
        .BackgroundStyle = msoBackgroundStylePreset4
    End With
    
    ' 背景画像「定式幕」を追加します。
    ' ActivePresentation.Pathはこのプレゼンテーションファイルのディレクトリを表しています。
    ' あらかじめ、定式幕.pngをこのプレゼンテーションファイルと同じディレクトリに配置しておきます。
    sld.Shapes.AddPicture ActivePresentation.Path + "\定式幕.png", msoFalse, msoTrue, 0, 0
    
    ' 俳句用の縦書きテキストボックスを作成します。
    Set haikuTb = sld.Shapes.AddTextbox( _
        msoTextOrientationVerticalFarEast, _
        sld.Master.Width / 2 - 50, 50, _
        180, 430)
    
    ' テキストボックスに文字列とフォントを設定します。
    With haikuTb.TextFrame2.TextRange.Characters
        .Text = Phrase1.Text + vbCrLf + Phrase2.Text + vbCrLf + Phrase3.Text
        .Font.NameFarEast = "HGS行書体"
        .Font.Size = "50"
    End With
        
    ' 作者用の縦書きのテキストボックスを作成します。
    Set autherTb = sld.Shapes.AddTextbox( _
        msoTextOrientationVerticalFarEast, _
        sld.Master.Width / 2 - 150, 180, _
        60, 300)
        
    ' テキストボックスに文字列とフォントを設定します。
    With autherTb.TextFrame2.TextRange.Characters
        .Text = Auther.Text
        .Font.NameFarEast = "HGS行書体"
        .Font.Size = "30"
        .ParagraphFormat.Alignment = 3      ' 右寄せ（縦書きでは下寄せ）にします。
    End With
    
    ' 図形の背景色を黒色にします。
    For i = 1 To sld.Shapes.Count
        sld.Shapes(i).Fill.ForeColor.SchemeColor = 1
    Next
    
    ' スライドを画像として保存します。
    sld.Export ActivePresentation.Path + "\" + Auther + "さんの俳句.png", "PNG", 1280, 720
        
    Unload HaikuRegister
            
End Sub

※このプログラムは https://gist.github.com/Nia-TN1012/99306aeaa7eabcc24317 で公開されています。

スライドを画像として保存する時は、Exportで出力先のファイル名と画像の形式、縦と横の大きさ（ピクセル単位）を指定します。

このプログラムを実行し、俳句と作者名を入力して、「俳句作成」ボタンを押すと、俳句カードの出来上がりです。

4. おわりに

このプログラムをGistにアップした時、ページが上手く推移しないので、アップされていないのかなと思い、Gist作成ボタンを押し過ぎてしまい、私のアカウントを一時的にSuspendさせてしまうアクシデントがありました（汗）（現在は復帰しています）。

[END]

月	火	水	木	金	土	日
				1	2	3
4	5	6	7	8	9	10
11	12	13	14	15	16	17
18	19	20	21	22	23	24
25	26	27	28	29	30