Excelで入力された文字列(台詞)からwavファイルを作成してみた。
機械音声のファイルを作成してみました。
意外と簡単に音声ファイル .wavを作ることができそうなので、
コードをアレンジしながら使ってみてください。
何か面白い使い方、アイデアがあったら(視聴者の皆さんがひらめいたら)
コメント欄やメッセージで教えてくださいね。
#ExcelVBA #音声ファイル #機械音声
下記、いつもの あのあの そのその 解説動画です
youtu.be
https://youtu.be/oQgYWk4gKYk
目次
00:00 0.あいさつ
00:34 1.音声ファイル作成のコードを修正
02:30 2.Excelのシートに台詞を書き、テストする
05:43 3.シートをコピーして使ってみる
08:32 4.蛇足で全ての台詞をまとめたファイルを作ってみた
0.あいさつ
最近、パワーポイントで機械音声のナレーションを使っていた
視聴者さまよりエクセルで音声ファイルを作成できないか?と質問が来たので、チャレンジしてみた。
Win10 64ビット Office365 Excel 64ビットでテストしました。
1.音声ファイル作成のコードを修正
下記、パワーポイントのノートを音声変換するコードです。
これを切り取って、
Excelで台詞とファイル名を渡されたら、作成するように変更しました
Sub 埋め込み() Dim n As Long '現在のスライド Dim strNote As String 'ノート取得 Dim cd As String 'フォルダを取得 Dim wavePath As String 'wavファイルを作成 Dim oFileStream, oVoice 'wavファイルに保存 Dim oSlide As Slide '音声データ Dim oShp As Shape '現在のスライドのノートを取得 n = ActiveWindow.Selection.SlideRange.SlideIndex strNote = ActivePresentation.Slides(n).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text 'ノートが空白なら終了 If strNote = "" Then Exit Sub End If '現在のフォルダを取得 cd = ActivePresentation.Path 'wavファイルのパスを作成 wavePath = cd & "\voice.wav" 'wavファイルに保存 Const SAFT48kHz16BitStereo = 39 Const SSFMCreateForWrite = 3 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 'audioオブジェクトの埋め込み(音声データを埋め込む) Set oSlide = ActivePresentation.Slides.Item(n) Set oShp = oSlide.Shapes.AddMediaObject2(wavePath, False, True, 10, 10) With oShp.AnimationSettings.PlaySettings .HideWhileNotPlaying = True End With End Sub
↑から、抜き出して
セリフ文字列と書き込みファイル名を受け取り
wavファイルを作成する
Sub 音声ファイル作成(strMOJI As String, wavePath As String) Dim oFileStream, oVoice 'wavファイルに保存 '音声変換文字列が空白なら終了 If strMOJI = "" Then Exit Sub End If 'wavファイルに保存 Const SAFT48kHz16BitStereo = 39 Const SSFMCreateForWrite = 3 Set oFileStream = CreateObject("SAPI.SpFileStream") oFileStream.Format.Type = SAFT48kHz16BitStereo oFileStream.Open wavePath, SSFMCreateForWrite Set oVoice = CreateObject("SAPI.SpVoice") Set oVoice.AudioOutputStream = oFileStream oVoice.Speak strMOJI '台詞を渡す、話す? oFileStream.Close Set oFileStream = Nothing Set oVoice = Nothing End Sub
2.Excelのシートに台詞を書き、テストする
シートのイメージ

C3にべースのファイル名を書き、
B列にNO 連番 と 言っても、自分で好きな番号をふり
D列に変換したい言葉、台詞を入力する
C列に出力先のファイル名を作成した。
=$C$3&TEXT(B6,"000")&TRIM(LEFT(D6,10))&".wav"
この表をループで回して、
機械音声の台詞ファイルを作成してみた。
Sub 台詞から音声ファイルを作る() Dim strFILENAME As String Dim n As Integer Dim str台詞 As String Dim r As Range Set r = Range("B5") '表の左上、基準値の場所をセット For n = 1 To 999 '最大999まで、そんなにいらないか str台詞 = Trim(r.Offset(n, 2)) If Len(str台詞) = 0 Then Exit For End If 'ファイル名をマクロ実行位置\連番+台詞 strFILENAME = ThisWorkbook.Path & "\" & r.Offset(n, 1) '音声ファイル作成 の サブルーチンを呼ぶ Debug.Print strFILENAME & " " & str台詞 Call 音声ファイル作成(str台詞, strFILENAME) Next MsgBox "終了しました、ファイルを確認してね" End Sub
3.シートをコピーして使ってみる
運用の例としては、シートをコピーして、管理するなど、使い方はいろいろと?
こんな感じで音声ファイルとして作成可能なので、使ってみてください。
何に?使うんだよ・・・
4.蛇足で全ての台詞をまとめたファイルを作ってみた
なんか、無計画で作成したので、
ファイル名の作り方とか・・・変だったけど、
下記、動画の最後、思い付きで追加したコードです。
Sub 台詞から音声ファイルを作る() Dim strFILENAME As String Dim n As Integer Dim str台詞 As String Dim strALL As String Dim r As Range Set r = Range("B5") '表の左上、基準値の場所をセット strALL = "" '初期化 For n = 1 To 999 '最大999まで、そんなにいらないか str台詞 = Trim(r.Offset(n, 2)) If Len(str台詞) = 0 Then Exit For End If strALL = strALL & str台詞 'ファイル名をマクロ実行位置\連番+台詞 strFILENAME = ThisWorkbook.Path & "\" & r.Offset(n, 1) '音声ファイル作成 の サブルーチンを呼ぶ Debug.Print strFILENAME & " " & str台詞 Call 音声ファイル作成(str台詞, strFILENAME) Next 'ループを抜けたら、すべてを作る 'ファイル名をマクロ実行位置\C3&全て.wav strFILENAME = ThisWorkbook.Path & "\" & Range("c3") & "全て.wav" '音声ファイル作成 の サブルーチンを呼ぶ Call 音声ファイル作成(strALL, strFILENAME) MsgBox "終了しました、ファイルを確認してね" End Sub
5.おわりの挨拶
意外と簡単に音声ファイルを作ることができそうなので、
コードをアレンジしながら使ってみてください。
何か面白い使い方、アイデアがあったら(視聴者の皆さんがひらめいたら)
コメント欄やメッセージで教えてくださいね。
では、またぁ・・・※蛇足のコードはいらなかったなぁ・・・と思いつつ・・・
ショート動画:
https://www.youtube.com/shorts/G8alaTJD-Xo
www.youtube.com
パワポのノートを音声変換した例:
www.youtube.com
https://www.youtube.com/watch?v=6gt1n0HZ6bM