Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その１
では、Windowsに標準で組み込まれている読上げの声で、Harukaの声以外を使って読上げる方法
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その２
では、読上げ内容を音声ファイルに保存する方法
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その３
では、スピード、ピッチ（声の音程）、更には、強調の指示方法
について、紹介しました。
今回は、ごく普通に使うセル参照を使って読上げする事例を紹介します。
読上げ内容をシートに配置する事例
前回までの内容で、声の主、スピード、声色（ピッチ）、強調の設定ができることを紹介しました。
Excelシートの配置を次のようにしてみます。
| A | B | C | D | E | |
|---|---|---|---|---|---|
| 1 | スピード | 強調 | ピッチ | 話し手 | 内容 |
| 2 | 2 | -2 | 一郎 | いつもお世話になっています。 | |
| 3 | -1 | Y | 4 | あゆみ | ありがとうございます。 |
| 4 |
2行目からデータが記述され、スピード、強調の有無、ピッチ、話し手、内容の順です。
各行のセル内容を読み込んでいきます。
'読み取りセルの変数設定 1-スピード 2-強調 3-ピッチ 4-話し手 5-内容
Dim cel(5) As Variant
'セル位置用変数 rw-行 erw-最終行 col-列 ecol-最終列
Dim rw, erw, col, ecol As Integer
'ワークシート用変数(短く記述するため)
Dim sht As Worksheet
'シート変数の設定
Set sht = Activesheet
'最終行を取得
erw = sht.Range("A2").SpecialCells(xlCellTypeLastCell).Row
'使う列は、5列なので、最終行は５
ecol = 5
'2行目から最終行まで繰り返し
rw = 2
Do While rw <= erw
'1列～5列 読込
For col = 1 To ecol
cel(col) = sht.Cells(rw, col)
Next
....
Loop
これで、シートに記述した情報を読み込むことができます。
erw = sht.Range("A2").SpecialCells(xlCellTypeLastCell).Row
について、「A2」セルを起点にして（.Range("A2")）、Excel内部で計算される
セルの特殊情報のうち、「xlCellTypeLastCell」つまり、最終の右下位置のセル位置情報を
参照して「.SpecialCells(xlCellTypeLastCell)」、そのセルの行（Row）をerwに
入れることを示します。
その他のセルの特殊情報は、
Microsoftの「XlCellType 列挙 (Excel)」
で説明されています。
XMLの設定をPrivate Sub で記述
スピード、ピッチ、強調は、XMLタグで記述しますので、Private Subにしておくと便利です。
'話す内容の前後にタグを付けるので２つの文字変数を設定
Dim mae, ato As Variant
'読上げ速度
Private Sub Spd(ByVal dt As Integer)
'-9未満なら-9に設定
If dt < -9 Then dt = -9
'9超えなら9に設定
If dt > 9 Then dt = 9
'XML開始指示 例：<Rate Speed="5">
mae = mae & "<Rate Speed=""" & dt & """>"
'XML終了指示
ato = "</Rate>" & ato
End Sub
'ピッチ(声色) pitch=24でオクターブ但し、±10の指示のみ許可
'W3Cでは超高音、高音、中音、低音、超低音に分かれているが、VBAでは中音指示
Private Sub pit(ByVal dt As Integer)
'-9未満なら-9に設定
If dt < -9 Then dt = -9
'9超えなら9に設定
If dt > 9 Then dt = 9
'XML開始指示 例：<pitch middle="5">
mae = mae & "<pitch middle=""" & dt & """> "
'XML終了指示
ato = "</pitch> " & ato
End Sub
'強調
Private Sub emp(ByVal dt As Variant)
'空白なら強調無し、何か有れば強調
If dt <> "" Then
'XML開始指示
mae = mae & "<emph> "
'XML終了指示
ato = "</emph> " & ato
End If
End Sub
'読み手の選択
Private Function tok(ByVal dt As Variant) As Integer
'とりあえず さやか指定
tok = 1
'指示無ければ さやか
If dt = "" Then
tok = 1
'指示されていれば
Else
'読み手の番号を計算
tok = InStr("はるかあゆみさやか一郎 Zir", dt) / 3 + 1
End If
End Function
....
'XML指示を初期化 mae = ""
ato = ""
'速度
Call spd(cel(1))
'強調
Call emp(cel(2))
'声色
Call pit(cel(3))
'読み手
Set spi.Voice = voic(tok(cel(4)))
'読上げ
spi.Speak mae & cel(5) & ato
....
*強調についてですが、はっきり、強めに言うということです。
したがって、スピード設定で早口にしても、はっきり言うことから、通常の速度で読上げます。
この中で、Private Function tok() を記述しました。
個別の話し手をHarukaVoice, AyumiVoice, SayakaVoice, IchiroVoice, ZirVoice とすると面倒ですので、voic()という変数を宣言しておいて、順に1～5で設定してあります。
'読み手のオブジェクト設定
Private Sub voi()
Dim spi, cat As Object
'SpeechAPIの設定
Set spi = CreateObject("SAPI.SpVoice")
'読み手の分類設定
Set cat = CreateObject("SAPI.SpObjectTokenCategory")
'分類の参照先をSpeechフォルダからSpeech_OneCoreに変更
cat.SetID "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Speech_OneCore\Voices", False
'読み手の名前を参照し、オブジェクト変数に収容
For Each token In cat.EnumerateTokens
'はるか
If token.GetAttribute("Name") = "Microsoft Haruka" Then _
Set HarukaVoice = token: Set voic(1) = token
'あゆみ
If token.GetAttribute("Name") = "Microsoft Ayumi" Then Set _
AyumiVoice = token: Set voic(2) = token
'さやか
If token.GetAttribute("Name") = "Microsoft Sayaka" Then _
Set SayakaVoice = token: Set voic(3) = token
'一郎
If token.GetAttribute("Name") = "Microsoft Ichiro" Then _
Set IchiroVoice = token: Set voic(4) = token
Next
'英語のZirは、Speech_OneCoreに無いので、Speechの中の英語(409)を指定
Set ZirVoie = spi.GetVoices("language=409")(0)
Set voic(5) = ZirVoice
Set cat = Nothing
Set spi = Nothing
End Sub
これで、処理が簡単になります。
読上げの事例
'行、列変数
Dim rw, col, erw, ecol As Integer
'ワークシート変数
Dim sht As Worksheet
'声のオブジェクト変数 はるか、Zir、一郎、あゆみ、さやか
Dim HarukaVoice, ZirVoice, IchiroVoice, AyumiVoice,SayakaVoice As Object
'声のオブジェクト変数
Dim voic(5) As Object
'SAPIのSpVoiceオブジェクト
Dim spi As Object
'セルの読込変数
Dim cel(5) As Variant
'XML指示記述用
Dim mae, ato As Variant
Sub 読上げ()
'話し手の設定
Call voi
'音声合成エンジン設定
Set spi = CreateObject("SAPI.SpVoice")
'割り込み許可
Application.EnableCancelKey = xlInterrupt
'現状のシート
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 spd(cel(1))
'強調
Call emp(cel(2))
'声色
Call pit(cel(3))
'読み手
Set spi.Voice = voic(tok(cel(4)))
'読上げ
spi.Speak mae & cel(5) & ato
Next
Set spi = Nothing
End Sub
といったことになります。
なお、
'割り込み許可
Application.EnableCancelKey = xlInterrupt
については、読上げている最中に止めたい場合に、「Break」キーを受け付ける設定にしました。
通常は、何行もの読上げをさせている場合でも、終了するまで止まりませんので。