0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

Excel VBA(マクロ)でセルの内容を声を変えて読上げ -その5-シートに書いた内容を録音(音声ファイルに保存する)事例

Last updated at Posted at 2023-05-04

Excel VBA(マクロ)でセルの内容を声を変えて読上げ -その1
では、Windowsに標準で組み込まれている読上げの声で、Harukaの声以外を使って読上げる方法

Excel VBA(マクロ)でセルの内容を声を変えて読上げ -その2
では、読上げ内容を音声ファイルに保存する方法

Excel VBA(マクロ)でセルの内容を声を変えて読上げ -その3
では、スピード、ピッチ(声の音程)、更には、強調の指示方法

Excel VBA(マクロ)でセルの内容を声を変えて読上げ -その4
で、実際のシートに書いた内容で読上げする事例

について、紹介しました。

今回は、シートに書いた内容を録音(音声ファイルに保存する)事例を紹介します。

Excelシートの配置を次のようにします。

A B C D E
1 スピード 強調 ピッチ 話し手 内容
2 2 -2 一郎 いつもお世話になっています。
3 -1 Y 4 あゆみ ありがとうございます。
4

2行目からデータが記述され、
一郎に少し早口で低めの声で「いつもお世話になっています。」
あゆみに少しゆっくりめの高めの声で、ちょっと強めの口調で「ありがとうございます。」
と話すことを示します。
スピードとピッチを調整して、OKと判断したら、録音をファイルに保存します。

基本的に、音声をスピーカーからファイルに切り替えるだけですので、読上げに対して、出力先の指示をするだけとなります。
その事例を示します。

'行、列変数
Dim rw, col, erw, ecol As Integer
'ワークシート変数
Dim sht As Worksheet
'SAPI.SpVoice用オブジェクト変数
Dim spi As Object
'SAPI.SpFileStream用オブジェクト変数
Dim vRec As Object
'SAPI.SpObjectTokenCategory用オブジェクト変数
Dim cat As Object
'声のオブジェクト変数 はるか、Zir、一郎、あゆみ、さやか
Dim HarukaVoice, zirVoice, IchiroVoice, AyumiVoice, SayakaVoice As Object
'声のオブジェクト変数
Dim voic(5) As Object
'セルの読込変数
Dim cel(5) As Variant
'XML指示記述用
Dim mae, ato As Variant

Sub 録音()
    '保存用ファイル名
    Dim fName
    '日付用変数
    Dim today As Date
    
    'SpeechAPI設定
    Set spi = CreateObject("SAPI.SpVoice")
    '録音用設定
    Set vRec = CreateObject("SAPI.SpFileStream")
    
    '今日
    today = Date
    'ファイル名をyyyymmdd.wavに設定
    fName = Year(today) & Right("0" & Month(today), 2) & Right("0" & Day(today), 2) _
    & ".wav"
    
    '保存先名をダイアログボックスを開いて設定
    fName = Application.GetSaveAsFilename(fName, "音声,*.wav")
    'キャンセルの場合は、終了
    If fName = False Then Exit Sub
    '保存用にファイルを上書きで開く
    vRec.Open fName, 3
    '録音先設定
    Set spi.AudioOutputStream = vRec
    
    '現状のシート
    Set sht = ActiveSheet
    '使用している最終行を検出
    erw = sht.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For rw = 2 To erw
        'A-1:速度 B-2:強調 C-3:声色 D-4:話し手 E-5:読上げ内容
        '1列を読込
        For col = 1 To 5
            cel(col) = sht.Cells(rw, col)
        Next
        'XML指示を初期化
        mae = ""
        ato = ""
        '速度
        Call rat(cel(1))
        '強調
        Call emp(cel(2))
        '声色
        Call pit(cel(3))
        '読み手
        Set spi.Voice = voic(tok(cel(4)))
        
        '読上げ
        spi.Speak mae & cel(5) & ato
    Next
    '完了したらファイルを閉じる
    vRec.Close
    '録音オブジェクトを解放
    Set vRec = Nothing
    'SAPIを解放
    Set spi = Nothing

End Sub

録音するファイル名については、その2で説明したものをそのまま使っています。
その他のPrivate Sub や Private Function につては、その4で説明したものを使用しています。

その6 -読上げる内容を調整し易くする事例- へ続く

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?