三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

Excel VBA 短い台詞から.wavファイル 機械音声を作成してみた


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のシートに台詞を書き、テストする

シートのイメージ

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

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)