【VBA】Speech.Speak 指定语音库

VBA Speech.Speak 指定语音库

Microsoft Speech API : https://docs.microsoft.com/zh-cn/previous-versions/windows/desktop/ms723602(v=vs.85)

Option Explicit

Public tts As Object '异步朗读时，tts变量要定义在声明区

Public Sub Speak(Name As String, Text As String, _
                 Optional SpeakAsync As Boolean, _
                 Optional SpeakXml As Boolean, _
                 Optional Purge As Boolean)
    
    If tts Is Nothing Then
        Set tts = CreateObject("SAPI.SpVoice")
    End If
    Set tts.voice = tts.GetVoices("Name=" & Name).Item(0)
    tts.Rate = 3 '速度
    tts.Volume = 100 '声音
    Dim flag As Integer
    flag = 0 'SpeechVoiceSpeakFlags.SVSFDefault
    If SpeakAsync = True Then flag = flag + 1 'SpeechVoiceSpeakFlags.SVSFlagsAsync
    If SpeakXml = True Then flag = flag + 8 'SpeechVoiceSpeakFlags.SVSFIsXML
    If Purge = True Then flag = flag + 2 'SpeechVoiceSpeakFlags.SVSFPurgeBeforeSpeak
    tts.Speak Text, flag '异步朗读时，tts变量要定义在声明区
End Sub

调用

Sub btn_Click()
    'Application.Speech.Speak "语音内容", True
    Speak "Microsoft Huihui Desktop", "语音内容", True
End Sub

查看本机可用的语音库

Option Explicit

Public tts As Object '异步朗读时，tts变量要定义在声明区

Public Sub AvailableVoices()
    If tts Is Nothing Then
        Set tts = CreateObject("SAPI.SpVoice")
    End If
    Dim i As Integer
    For i = 0 To tts.GetVoices.Count - 1
        Set tts.Voice = tts.GetVoices.Item(i)
        Debug.Print " " & i & " : " & tts.Voice.GetDescription
    Next i
End Sub