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