解决VB调用TTS实现真人发音

(1)新建一个工程：

     工程-引用-microsoft-speech-object-library

(2)建一个按钮：

Private Sub Command1_Click()
    textch = "测试VB真人发音"
    readch (textch)
End Sub
Function readch(ByVal strText As String)
    Set objVoice = CreateObject("SAPI.SpVoice")
    Set colVoice = objVoice.GetVoices() '获得语音引擎集合
    objVoice.Volume = 100 '设置音量，0到100，数字越大音量越大
    '得到所需语音引擎的编号
    langCN = "MSSimplifiedChineseVoice" '简体中文
    langEN = "MSSam" '如果安装了TTS Engines 5.1，还可以选择MSMike,MSMary
    For i = 0 To colVoice.Count - 1 '选择语音引擎
  
        If Right(colVoice(i).Id, Len(langCN)) = langCN Then cnVoice = i
        If Right(colVoice(i).Id, Len(langEN)) = langEN Then enVoice = i
    Next
    Dim strSourse, strCurrent, strTemp, strSplitter As String
    Dim strArray() As String
    strSource = strText & " "
    strTemp = ""
    strSplitter = "@@"
    '把strSource中的中英文分开
    For i = 1 To Len(strSource) - 1
        strCurrent = Mid(strSource, i, 1)
        If is_hanzi(strCurrent) = is_hanzi(Mid(strSource, i + 1, 1)) Then '如果是中文
            strTemp = strTemp & strCurrent
        Else
            strTemp = strTemp & strCurrent & strSplitter
        End If
    Next
  
    strTemp = Replace(strTemp, "@@ @@", " ") '空字符会被识别为英文，予以纠正
    MsgBox strTemp
  
    strArray = Split(strTemp, strSplitter)
    For Each strSlice In strArray
        If Trim(strSlice) = "" Then
            GoTo endfor
        End If
     
        If is_hanzi(Mid(strSlice, 1, 1)) Then
            Set objVoice.Voice = colVoice.Item(cnVoice) '设置语音引擎为简体中文
            objVoice.Speak (strSlice)
        Else
            Set objVoice.Voice = colVoice.Item(enVoice)
            objVoice.Speak (strSlice)
        End If
endfor:
    Next
End Function
Private Function is_hanzi(ByVal str_char As String)
    If AscW(str_char) > &H0 And AscW(str_char) < &H800 Then
        is_hanzi = False
    Else
        is_hanzi = True
    End If
End Function