Discussion :

[patricktoulon]

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

[Godzestla]

Impressionnant.

[Philippe Tulliez]

Bonjour,
Pas mal, assez surprenant.

[Marc-L]

Sympa Patrick !

maintenant si on doit comparer avec le speech de l'application

En changeant dans le code ligne n°7 fr par en ! …

Le Speech de mon côté est refusé sur une version 2003 …

Là non seulement on dispose d'une voix française correcte et il est facile de changer de pays !

[Marc-L]

Allez, à moi de t'embêter Patrick !

Suite à un plantage d'une application, je me suis rendu compte que l'application WMPlayer était toujours résidente.

Effectivement car, pour que ta fonction Kill fonctionne (attention ce mot-clef existe déjà en VBA !),

il faudrait corriger la ligne n°54 ainsi : Command = "cmd /c Taskkill /F /IM """ & Process & """" …

Erreur repérable car normalement sans espace après l'opérateur de concaténation & VBA met la ligne en erreur (rouge) …

Après cette correction, l'application est bien déchargée mais il n'y a plus de voix !
Normal car la ligne n°59 de la pause a été mise en commentaire …
Mais en la réactivant, cette ligne déclenche une erreur d'exécution '424' : Objet requis …

Je te laisse corriger ta sympathique contribution !

[patricktoulon]

Bonjour a tous
allez VBA pour VBA on reprend ca
marc voila une version qui pourra peut être t'apporter satisfaction
j'ai virer killprocess tel qu'elle l'était j'ai utilisé la recherche de processus en vba et j'ai refait une macro complète et fonctionnelle

j'ai remis aussi la pause
j'ai ajouté un argument a la fonction principale "le language"
maintenant on le déclare l'ors de l'appel a la fonction comme ca plus besoins de toucher au code
voila du pure VBA
qu'Est ce qu'il est exigeant ce marc alors
Vous remarquerez aussi des virgule qui n'ont pas leur place dans le texte ,en fait la virgule met un léger temps de silence en plus ce qui permet de rendre plus intelligible la dictée et d'avoir une ponctuation phonique plus ou moins correcte

Allez test en Français

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub test_en_francais()
dictée "bonjour tout le monde ,comment sa va aujourd'hui" & vbCrLf & "je trouve que nous avons un beau soleil radieux ", "fr"
End Sub

test en englais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub test_en_englais()
dictée "hello every body ,,are you find today" & vbCrLf & "  ,, we ave a beautiful sun today ,,,,,,are you OK", "en"
End Sub

et maintenant le module

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
62
63
64
 
Function dictée(texte, langue)
Dim sTxt, URLFR
'sTxt =""
URLFR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=" & langue & "&q=" & texte
If OnLine("smtp.gmail.com") = True Then
   Wmplayer_stop
   Call WmPlaySound(URLFR)
   Pause (10)
  Wmplayer_stop
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 Wmplayer_stop()
    Dim service As Object
    Dim sQuery As String
    Dim processus
    Set service = GetObject("winmgmts:root\cimv2")
    sQuery = "select * from win32_process where name='" & "wmplayer.exe" & "'"
    For Each processus In service.execquery(sQuery)
        processus.Terminate
    Next
    Set service = Nothing
End Sub
'**********************************************************************************************
   Sub Pause(NSeconds)
    Application.Wait (Now + TimeValue("0:00:0" & NSeconds))
   End Sub
'**********************************************************************************************

et tout ca sans les apis! ca c'est kool


Un dernier petit essai

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub test_en_francais()
dictée "Marc n'est jamais content " & vbCrLf & "il en veut toujours plus " & "j'espère que celle la va lui convenir ", "fr"
End Sub

[Marc-L]

Là je n'ai plus le temps mais apparemment :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub Reponse()
    dictée "Va tutto bene !", "it"
End Sub

Enfin si pour chipoter : « English » c'est bien avec un E mais « Anglais » c'est avec un A et non pas un E !

[patricktoulon]