オンライン講義に対応するため、講義用パワーポイントのノート欄に書いた内容を、自動で読み上げ画面も切り替わるVBAマクロを作ってみました。普通には、スライドを表示しながら解説を自分でしゃべって、それを記録し、スライドに音声ファイルを挿入していく作業となります。以前にそれで音声付パワポを作成した経験があります。
とても地道な作業です。
なかなか良好な録音環境が難しく どうしてもノイズが入ってしまいます。
９０分間、全くノイズが無い環境を確保するのはスタジオでなければムリ！ ではないでしょうか。。。 また、途中でかんでしまうと再録音です。
そこで発見したのが「読み上げ」機能です。
これはOfficeに標準で備わっている機能で、選択したテキストを音声合成エンジンが読み上げてくれます。この機能を使って、パワポのノートに記述した解説を読み上げたら！ と、ここで問題は、スライドショーを表示している状態では、ノートのテキストを選択できない！ということです。
さらにネット上を検索したところ、以下のVBAサンプルコードがありました。
・スライドに設置したボタンを押すとノートのテキストをしゃべるパワポ
・スライドが切り替わると実行するマクロ
この２つを組み合わせることで、自動でスライドを切り替え表示しながらノートのテキストを読み上げるパワポを作成することができました。これでノート欄に解説を記述するだけで自分でしゃべって録音する必要がなくなりました。解説内容をじっくり推敲することができます。また、解説内容を容易に変更することが可能となりました。
以下にVBAコードの簡単な説明をします。
コピーしてPowePointのVBエディタを起動し、標準モジュールに貼り付けて実行して下さい。
Sub OnSlideShowPageChange(ByVal ss As SlideShowWindow)
'' スライド位置を取得
Dim n As Long
n = ss.View.CurrentShowPosition - 1
'' 現在のスライドを取得
Dim note As SlideRange
Set note = ActivePresentation.Slides(n).NotesPage
'' ノート欄を取得
Dim shp As Shape
Set shp = note.Shapes.Placeholders(2)
'' ノート欄のテキストを取得
Dim NoteText As String
NoteText = shp.TextFrame.TextRange.Text
'' ノート欄が空の場合は終了
If NoteText = "" Then
Exit Sub
End If
'' 音声合成エンジンを取得
Dim sv As Object
Set sv = CreateObject("SAPI.SpVoice")
'' 速度を設定
sv.Rate = -1
'' 日本語の音声合成エンジンを検索して取得
For n = 0 To sv.GetVoices.Count - 1
If InStr(sv.GetVoices.Item(n).GetDescription, "Japanese") Then
Set sv.Voice = sv.GetVoices.Item(n)
Exit For
End If
Next
'' 日本語の音声合成エンジンが無かった場合
'' その旨をメッセージボックスに表示
If InStr(sv.Voice.GetDescription, "Japanese") < 1 Then
MsgBox "日本語の音声合成エンジンがありません。" & vbCrLf & _
"現在の設定 : " & sv.Voice.GetDescription
Exit Sub
End If
'' 音声合成実行
sv.Speak NoteText
'' 音声合成エンジンを開放
Set sv = Nothing
End Subなお、3項では音声合成エンジンがうまく起動しないことがあるので、1枚目のスライドの枠外に小さいActivX（ボタン等）を貼り付けます。また、4項のスライド設定でクリックしたときに画面を切り替えるようにすると画面が切り替わった後に、そのスライドのノート欄を自動でしゃべり止まります。自動で切り替えるようにすると、最後まで自動再生しながら自動でしゃべります。途中で停止する場合は「Ecs」キーを押します。
参考URL
・しゃべるパワポの作り方
・パワーポイントマクロ PowerPoint VBAの使い方
» ノート » NotesPage.Shapes.Placeholders(2)とは
・PowerPointの自動実行マクロ
コメント