嗷嗷叫的老马

Option Explicit
'ModTTS.bas
'
'利用TTS引擎朗读文本,支持中英文混读
'
'网上收集,原帖地址: http://blog.sina.com.cn/s/blog_5d8945610100e2qz.html
'
'TTS与真人语音引擎在这里下载: http://www.lingoes.cn/zh/translator/speech.htm
'
'By 嗷嗷叫的老马
'http://www.m5home.com

Function ReadText(ByVal strText As String)
    Dim objVoice As Object, colVoice As Object
    Dim strSource As String, strCurrent As String, strTemp As String, strSplitter As String
    Dim strArray() As String, strSlice As Variant
    Dim langCN As String, langEN As String
    Dim I As Long, cnVoice As Long, enVoice As Long
    
    Set objVoice = CreateObject("SAPI.SpVoice")
    Set colVoice = objVoice.GetVoices()    '获得语音引擎集合
    
    objVoice.Volume = 100    '设置音量，0到100，数字越大音量越大
    
    '得到所需语音引擎的编号
    langCN = "MSSimplifiedChineseVoice"    '简体中文
    langEN = "MSSam"    '如果安装了TTS Engines 5.1，还可以选择MSMike,MSMary
'    langCN = "VW Lily"    '简体中文
'    langEN = "VW Lily"    '如果安装了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
        Debug.Print colVoice(I).id                      '列出本机已安装的语音引擎
    Next
    
    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