PowerPointでノートを自動読み上げ！マクロ活用で簡単ナレーション作成

2025.04.01

皆さん、PowerPointのプレゼン資料に自動でナレーションをつけられたら便利だと思いませんか？実は、PowerPointのノート部分に書いた文章を自動で読み上げてくれるマクロがあるんです。今回は、その設定方法から活用方法まで、初心者の方にもわかりやすくご紹介します。

PowerPointのノート機能とは？
マクロを使ってノートを自動読み上げする方法
ナレーション付き動画の作成方法
よくある質問や疑問
今すぐ解決したい！どうしたらいい？
まとめ

PowerPointのノート機能とは？

PowerPointのイメージ

まず、PowerPointのノート機能について簡単に説明します。スライドの下部にあるノート欄には、プレゼン時の補足情報や話す内容をメモしておくことができます。このノート部分を活用して、自動で読み上げるナレーションを作成することが可能です。

マクロを使ってノートを自動読み上げする方法

では、実際にマクロを使ってノートを自動で読み上げる方法を見ていきましょう。手順は以下の通りです。

PowerPointの「開発」タブを表示させます。表示されていない場合は、「ファイル」→「オプション」→「リボンのユーザー設定」から「開発」にチェックを入れてください。
「開発」タブの「Visual Basic」をクリックし、VBAエディタを開きます。
「挿入」→「標準モジュール」を選択し、新しいモジュールを追加します。
以下のコードをコピーして、追加したモジュールに貼り付けます。

vba

Sub SlideVoice()

    Dim i As Long

    With ActivePresentation

        For i = 1 To .Slides.Count

            Dim strNote As String

            strNote = .Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text

            If strNote <> "" Then

                Dim cd As String

                cd = .Path

                Dim wavePath As String

                wavePath = cd & "\voice.wav"

                Const SAFT48kHz16BitStereo = 39

                Const SSFMCreateForWrite = 3

                Dim oFileStream, oVoice

                Set oFileStream = CreateObject("SAPI.SpFileStream")

                oFileStream.Format.Type = SAFT48kHz16BitStereo

                oFileStream.Open wavePath, SSFMCreateForWrite

                Set oVoice = CreateObject("SAPI.SpVoice")

                Set oVoice.AudioOutputStream = oFileStream

                oVoice.Speak strNote

                oFileStream.Close

                Dim oSlide As Slide

                Dim oShp As Shape

                Set oSlide = .Slides(i)

                Set oShp = oSlide.Shapes.AddMediaObject2(wavePath, False, True, 10, 10)

                With oShp.AnimationSettings.PlaySettings

                    .PlayOnEntry = True

                    .HideWhileNotPlaying = True

                End With

                Dim fso As Object

                Set fso = CreateObject("Scripting.FileSystemObject")

                If fso.FileExists(wavePath) Then Kill wavePath

            End If

        Next i

    End With

    MsgBox "音声埋め込み完了"

End Sub