このGistに上がっているVBAソースファイルの概要
- Haiku-powerpoint.vb : Ver. 1.0 : 俳句を縦書きテキストボックスに俳句を書き込みます。
- Haiku-powerpoint2.vb : Ver. 2.0 : ユーザーフォームから入力した任意の俳句を縦書きテキストボックスに書き込み、画像ファイルを出力します。
このGistに上がっているVBAソースファイルの概要
' Auther : Nia Tomonaka | |
' Twitter : https://twitter.com/nia_tn1012 | |
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 | |
' Haiku-powerpoint.vb ( PowerPointのVBA用 ) | |
' Copyright (c) 2014-2015 Myoga-TN.net All Rights Reserved. | |
' This software is released under the MIT License. | |
' http://opensource.org/licenses/mit-license.php |
' Auther : Nia Tomonaka | |
' Twitter : https://twitter.com/nia_tn1012 | |
' PowerPointスライドに縦書きテキストボックスを追加して任意の俳句を書き込み、 | |
' 画像ファイルを出力するモジュールです。 | |
' ユーザーフォーム(HaikuRegister)にテキストボックス | |
' (Phrase1、Phrase2、Phrase3、Auther)を用意し、そこに俳句と作者を入力します。 | |
' 俳句を生成するボタンを押すとこのイベントが呼び出されます。 | |
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 | |
' Haiku-powerpoint2.vb ( PowerPointのVBA用 ) | |
' Copyright (c) 2014-2015 Myoga-TN.net All Rights Reserved. | |
' This software is released under the MIT License. | |
' http://opensource.org/licenses/mit-license.php |