GetVoices("Gender=Male;Language=409")(0)と
Gender=Maleで男性声
Language=409で英語US
を指定しただけのコードなんですが、、、
環境によっては男性声の追加が必要です。
そんなお話です。
youtu.be
https://youtu.be/3E1H-c46DZA
目次
00:00 1.やりたいこと
00:20 現在使用可能な声の名称を取得
02:21 Windows設定 音声認識から言語の追加をやってみる
05:06 追加音声・声の確認
06:14 4.修正結果のテスト
#パワーポイント #読み上げ #PowerPoint #PowerPointVBA #マクロ
#SAPI #GetVoices #Microsoft #ms365 #Windows10
1.やりたいこと
男性の声で読み上げを行いたい・・・
と質問をみかけたので、少し調べてみました。
Gender=Male;
Gender=Female;
をパラメーターに追加すると、可能?
2.テストしてみます
テストしたけど、、、動かない
笑い
SpVoiceを検索すると、
MSのページ
learn.microsoft.com
SpVoice (SAPI 5.3)
https://learn.microsoft.com/en-us/previous-versions/windows/desktop/ms720149(v=vs.85)
が見つかります。
ここのサンプルから、
For Each objVoice In objSAPI.GetVoices
Debug.Print "Name=", objVoice.GetDescription
Next
と、GetVoicesを総当たり、して現在使用可能な声の名称を取得してみました。
Sub test001() '単純にSAPI.SpVoiceを使用してみた Dim objSAPI As Object Set objSAPI = CreateObject("SAPI.SpVoice") Dim objVoice As Object For Each objVoice In objSAPI.GetVoices Debug.Print "Name=", objVoice.GetDescription Next Debug.Print "Language=409を指定" For Each objVoice In objSAPI.GetVoices("Language=409") Debug.Print "Name=", objVoice.GetDescription Next Debug.Print "Gender=Maleを指定" For Each objVoice In objSAPI.GetVoices("Gender=male") Debug.Print "Gender=", objVoice.GetDescription Next '言語指定の追加 2023/03/11 Dim US '言語の指定 テストで英語USにしてみた。 'Gender=Male;の指定を追加 2023/03/16 'Set US = objSAPI.GetVoices("Gender=Male;Language=409")(0) 'Gender=Male;409:英語US 'Set objSAPI.voice = US objSAPI.Speak "I Love You" '.Speakに文字列を渡し読み上げる Set objSAPI = Nothing End Sub
結果は、
Name= Microsoft Haruka Desktop - Japanese
Name= Microsoft Zira Desktop - English (United States)
Language=409を指定
Name= Microsoft Zira Desktop - English (United States)
Gender=Maleを指定
で、無指定でも2件しかなく、
Language指定で、1件、
Gender指定では、0件でした(Haruka Desktop - Japaneseは名前からして女性?)
ジェンダーレスのこの時代に
あまり、男性声、女性声と言ってると怒られそうですが、
(最近は、ゲームでも、Type-A,B,声1,2など、気を使いすぎてるしね・・
そんな余計な話は、置いといて)
3.一度しかテストできない、言語の追加をやってみる
大げさな、消せば、再テストできそうだけど、
設定から
音声認識
言語の追加で
読み上げ言語を追加してみます。
私のデフォルト環境では
Name= Microsoft Haruka Desktop - Japanese
Name= Microsoft Zira Desktop - English (United States)
と、二つしかないみたいなので、
思い切って、Win10の設定から言語を追加してみます。
※追加して、出てこなかったら、お蔵入りっぽい失敗動画として、残す予定
言語追加後
Name= Microsoft Haruka Desktop - Japanese
Name= Microsoft David Desktop - English (United States)
Name= Microsoft Zira Desktop - English (United States)
Name= Microsoft Hazel Desktop - English (Great Britain)
Language=409を指定
Name= Microsoft David Desktop - English (United States)
Name= Microsoft Zira Desktop - English (United States)
Gender=Maleを指定
Gender= Microsoft David Desktop - English (United States)
無事に声が増えました。
4.修正結果のテスト
追加したソースコード
'Win10 MS365のPowerPointでテスト ' Sub スライドノート読み上げUS409指定Gender_Male() Dim strNOTE As String '読み上げたいノートの文字列 'コードが長いけど、現在のスライドノートを取得 '...Placeholders(2)なんで2?これで取得できるので・・・ strNOTE = SlideShowWindows(1).View.Slide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text Debug.Print "ノート:" & strNOTE 'ノートが空白なら終了 If strNOTE = "" Then MsgBox "ノートが見つかりません" Exit Sub 'メッセージ End If '↑上で取得したノートを改行 CR で区切る Dim txtLINE As Variant 'Splitの結果を受け取りたいのでVariant txtLINE = Split(strNOTE, vbCr) '単純にSplitでCR区切りの配列を作成 '字幕を表示するテキストボックスを存在チェックを兼ねて事前代入 Dim objTextShp As Shape '字幕の表示エリアを入れる Set objTextShp = Nothing 'チェックを兼ねて初期化 On Error Resume Next 'エラーが発生しても強引に次の命令に行け '"テキスト字幕エリア" って固定名のテキストボックスを代入する Set objTextShp = SlideShowWindows(1).View.Slide.Shapes("テキスト字幕エリア") On Error GoTo 0 'ここから先は、いつものエラー処理に忘れないで戻すぞ If objTextShp Is Nothing Then 'Nothing=テキストボックスが用意されていない時は MsgBox "テキスト字幕エリア の名称で表示場所のTextBoxを用意してください" Exit Sub 'メッセージ End If 'やっとノート読み上げ と 字幕をセット Dim n As Integer 'ラインのカウンター '単純にSAPI.SpVoiceを使用してみた Dim objSAPI As Object Set objSAPI = CreateObject("SAPI.SpVoice") '言語指定の追加 2023/03/11 Dim US '言語の指定 テストで英語USにしてみた。 'Gender=Male;の指定を追加 2023/03/16 Set US = objSAPI.GetVoices("Gender=Male;Language=409")(0) 'Gender=Male;409:英語US Set objSAPI.voice = US For n = 0 To UBound(txtLINE) '単純に配列数分 文字列セットと読み上げを繰り返す Debug.Print n, txtLINE(n) objTextShp.TextFrame2.TextRange.Text = txtLINE(n) '字幕のセット DoEvents objSAPI.Speak txtLINE(n) '.Speakに文字列を渡し読み上げる DoEvents Next objTextShp.TextFrame2.TextRange.Text = "字幕の表示エリア" 'ループを抜けたら、クリアしとく Set objSAPI = Nothing End Sub
なんとか、なったのかなぁ?
パワポ ノートをUS男性読みの参考となれば幸いです。
余談・余白:
チャットボットに紹介文とタイトルを作ってもらいました。
なんだか、そのまま使うのが恥ずかしい紹介文ですね・・・
読み上げるテキストを男性の声で読み上げたいというニーズがあり、
WindowsのSAPIを用いて、可能かどうかを調べた結果が述べられています。
SAPIのGetVoicesメソッドを使用し、現在使用可能な声の名称を取得しました。
また、言語や性別の指定によって、読み上げる声を変更できることがわかりました。
最終的には、Win10の設定から言語を追加することで、
読み上げる声を増やすことに成功しました。
「男性声で英語を読み上げてみたら」というタイトルが考えられます。
キーワード:SAPI, Windows, 読み上げ, 声, 性別, 言語, GetVoices, Microsoft, PowerPoint
パワポ ノート読みの関連カコ記事:
ken3memo.hatenablog.com