Bonjour a tous
il y a quelque temps hackoofr avait fait un petit hta utilisant le Google speech(voix Google )
aujourd'hui dans une autre discutions il en a sorti un autre en vbs plus performant
je n'en suis pas l'auteur mais je vous le livre car il a le merite de parfaitement fonctionner avec une intelligibilité plus que raisonnable
e
donc en vba ca donne ca :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
 
Option Explicit
 
Function dictée(texte)
Dim sTxt, URLFR
'sTxt =""
URLFR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & texte
If OnLine("smtp.gmail.com") = True Then
   Call Kill("wmplayer.exe")
   Call WmPlaySound(URLFR)
   Pause (10)
   Call Kill("wmplayer.exe")
End If
End Function
'**********************************************************************************************
Function OnLine(strHost)
Dim objPing, z, objRetStatus, PingStatus
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
    z = 0
    Do
        z = z + 1
        For Each objRetStatus In objPing
            If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
                PingStatus = False
            Else
                PingStatus = True
            End If
    Next
        Call Pause(1)
        If z = 4 Then Exit Do
    Loop Until PingStatus = True
    If PingStatus = True Then
        OnLine = True
    Else
        OnLine = False
    End If
End Function
'*********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
   DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
   Sub WmPlaySound(MySound)
      Dim WshShell
      Set WshShell = CreateObject("WScript.Shell")
      WshShell.Run "wmplayer " & DblQuote(MySound) & "", 0, False
      Set WshShell = Nothing
   End Sub
'**********************************************************************************************
Sub Kill(Process)
      Dim Ws, Command, Execution
      Set Ws = CreateObject("WScript.Shell")
      Command = "cmd /c Taskkill /F /IM ""&Process&"""
      Execution = Ws.Run(Command, 0, True)
   End Sub
'**********************************************************************************************
   Sub Pause(NSeconds)
     ' Wscript.Sleep (NSeconds * 1000)
   End Sub
'**********************************************************************************************
et pour s'en servir il n'y a qu'a faire ceci
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
 
Sub test()
dictée "bonjour tout le monde ,comment sa va aujourd'hui" & vbCrLf & "je trouve que nous avons un beau soleil radieux "
End Sub
maintenant si on doit comparer avec le speech de l'application
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
 
Sub applicationsSpeech()
  Application.Speech.Speak "bonjour tout le monde ,comment sa va aujourd'hui" & vbCrLf & "je trouve que nous avons un beau soleil radieux "
 ' LE RESULTAT PARLE DE LUI MEME SANS COMMENTAIRE 
End Sub
sachant qu'avec seven il faut payer pour avoir une voix en Français

vous constaterez que le résultat est comment dire heu.....

je le répète je ne suis pas l'auteur de se script je l'ai juste remanier pour vba

mais j'ai pensé qu'il avait néanmoins ca place dans les contributions vba

je remercie encore hackoofr pour ces trouvailles toujours aussi spectaculaires les une que les autres

BIEN SUR POUR QU'IL FONCTIONNE IL FAUT ETRE CONNECTE!!!!!!



Voila bonne dictée