三流君 ken3のmemo置き場

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

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

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

パワポ ノートの英語を男声で読ませたい Gender=Maleを指定する Windows設定・音声認識から英語の声を追加する手順

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

ken3memo.hatenablog.com

ken3memo.hatenablog.com

ken3memo.hatenablog.com

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



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