PowerPointのVBAでノートを自動読み上げしたい、という質問です。
PowerPointのVBAでノートを自動読み上げしたい、という質問です。 「スライドショーで、スライドが変わるたびにそのスライドのノートを音声合成機能で読み上げる」機能を盛り込みたいのです。 標準モジュールに下記のコードを書きました。 ノート部分の入力文字を取得するところまでは上手くいったのですが、音声読み上げサブルーチン(SpeakSPI)に飛ばすことがうまくいっていかないのです。(Debug.Printでここに遷移しているかを確認したら、無表示だったので) Win10+PowerPoint2016です どのように直せばよいか、アドバイスをお願いします。 Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow) Dim n As Long n = SlideShowWindows(1).View.CurrentShowPosition ' 現在のスライドのノートを取得 Dim note As SlideRange Set note = ActivePresentation.Slides(n).NotesPage Debug.Print "②名前: " & note.Name ' ノート欄の文字列を取得 Dim strNote As String strNote = note.Shapes.Placeholders(2).TextFrame.TextRange.Text '' ノート欄が空の場合は,読み上げ処理を行わずに終了 If strNote = "" Then Exit Sub End If '自動音声読み上げサブルーチンへ Call SpeakSPI(strNote) ’変数初期化 strNote = "" Set note = Nothing n = "" End Sub Sub SpeakAPI(ByVal strNote2 As String) ' 音声合成エンジンを取得 Dim sv As Object Set sv = CreateObject("SAPI.SpVoice") '' インストールされている音声合成エンジンのうち、最初に見つかった日本語のものを選択 For i = 0 To sv.GetVoices.Count - 1 If InStr(sv.GetVoices.Item(i).GetDescription, "Japanese") Then Set sv.Voice = sv.GetVoices.Item(i) Exit For End If Next '' 日本語のエンジンが見つからなかった場合 If InStr(sv.Voice.GetDescription, "Japanese") < 1 Then '' 発見に失敗した旨をメッセージボックスで通知 MsgBox "日本語のエンジンが見つかりませんでした。" & vbCrLf & _ "現在の設定 : " & sv.Voice.GetDescription Exit Sub End If '' 音声合成実行 sv.Speak strNote2 '' 音声合成エンジンを開放 Set sv = Nothing End Sub
Visual Basic | PowerPoint・1,172閲覧・50