les voix onecore (Paul et julie) utilisable avec Sapi 5 2.0

'Tutoriel 7264 excel parle
auteur: patricktoulon
Option Explicit

Dim oldPrenom As String
Dim actualprenom As String
Const Lp As String = " ..." 'petite pause
Const bp As String = " ... " 'grande pause

Sub TestCompletVoix()
    ' Sauvegarder la voix actuelle
    oldPrenom = GetDefautVoice
  
    ' Changer et tester
    ChangerVoixParDefautSAPI "hortense"
    actualprenom = "Hortense"
    TestVoixParDefaut
  
    ChangerVoixParDefautSAPI "paul"
    actualprenom = "Paul"
   TestVoixParDefaut
  
    ChangerVoixParDefautSAPI "julie"
    actualprenom = "julie"
   TestVoixParDefaut
  
    ' Restaurer la voix initial
    If oldPrenom <> "" Then
         ChangerVoixParDefautSAPI oldPrenom
        Application.Speech.Speak " C'est moi" & Lp & "hortense" & bp & "apres Julie et paul ,me revoila de retour "
    End If
End Sub

'cette macro récupère le prénom de la voix par défaut
Function GetDefautVoice() As String
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    On Error Resume Next
    Dim chemin As String
    GetDefautVoice = ""
    chemin = LCase(wsh.RegRead("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Speech\Voices\DefaultTokenId"))
    Debug.Print chemin
    If InStr(chemin, "hortense", vbTextCompare) > 0 Then GetDefautVoice = "hortense": Exit Function
    If InStr(chemin, "paulm", vbTextCompare) > 0 Then GetDefautVoice = "paul": Exit Function
    If InStr(chemin, "julie", vbTextCompare) > 0 Then GetDefautVoice = "julie": Exit Function
    If Err Then
        MsgBox "Attention !! l'application n'a pas pu determiner la voix " & " cette exemple ne gere que les voix francaises (Hortense , Julie , Paul)"
    End If
    On Error GoTo 0
End Function



'cette macro change la voix par defaut
Sub ChangerVoixParDefautSAPI(nomVoix As String)
    Dim wsh As Object, cheminCle As String
  
    Set wsh = CreateObject("WScript.Shell")
  
    Select Case LCase(nomVoix)
        Case "hortense"
            cheminCle = "HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Speech\Voices\Tokens\TTS_MS_FR-FR_HORTENSE_11.0"
        Case "paul"
            cheminCle = "HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Speech\Voices\Tokens\MSTTS_V110_frFR_PaulM"
        Case "julie"
            cheminCle = "HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Speech\Voices\Tokens\MSTTS_V110_frFR_JulieM"
        Case Else
            MsgBox "Voix inconnue : " & nomVoix, vbCritical
            Exit Sub
    End Select
  
    On Error Resume Next
    wsh.RegWrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Speech\Voices\DefaultTokenId", cheminCle, "REG_SZ"
    If Err Then
        MsgBox "l'application n'a pas pu changer la voix" & vbCrLf & " Vérifiez la syntaxe ou la chaine de la clé!!!"
    End If
    On Error GoTo 0
End Sub

'macro de test de voix
Sub TestVoixParDefaut()
    Application.Speech.Speak "Bonjour, c'est moi" & Lp & actualprenom & bp & " je suis la voix actuellement définie par défaut dans  Windows."
End Sub