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

2015.02.28
Nia-TN-SDF-A2

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

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

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からテキストボックスの仕様が変わったのかな。

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

vba04

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は名前の通り、スライドの背景のスタイルのプリセットを表しています。

vba04b

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]

コメント

タイトルとURLをコピーしました