[VBS] Problème avec les caractères accentués dans un msgbox ?

Version imprimable

:salut:
Je suis entrain d'écrire un vbscript qui utilise Google speech pour la prononciation d'un message
je suis obligé d’enregistrer ce code dans le notepad++ avec l'encodage UTF8 sans BOM et la prononciation est bonne :plusser: , mais l'affichage de la message box n'est pas bonne pour les caractères accentués :roll:
Comment résoudre ce genre de problème ?
:merci:

Code:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
    Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public
    Dim Message,URLFR
    Message = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est : "
    URLFR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & Message
    Titre = "Adresse Ip Publique !"
    URL = "http://monip.org"
    If OnLine("smtp.gmail.com") = True Then 
        Set ie = CreateObject("InternetExplorer.Application")
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        ie.Navigate (URL)
        ie.Visible=False
        DO WHILE ie.busy
            Wscript.Sleep 100
        Loop
        Data = ie.document.documentElement.innertext
        Set objRegex = new RegExp
        objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
        objRegex.Global = False
        objRegex.IgnoreCase = True
        Set Matches = objRegex.Execute(Data)
        For Each Match in Matches
            Call Kill("wmplayer.exe")
            Call WmPlaySound(URLFR & Match.Value)
            MsgBox Message & Match.Value,64,Titre
            Pause(10)
            Call Kill("wmplayer.exe")
        Next
        ie.Quit
        Set ie = Nothing
    Else
        MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
        Exit Sub
    End If
End Sub
'************************************************************************************************************************************************************
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
'**********************************************************************************************

Bonjour Hackhoofr,

Je ne suis pas sûr d'avoir bien compris, néanmoins, est-ce qu'une fonction de transformation de ta chaine de caractères en ré-intégrant les codes ASCII résoudrait ton souci ?
"Voilà une belle journée d'été" ---> "Voil" & chr(133) & " une belle journ" & chr(130) & "e d'" & chr(130) & "t" & chr(130)

Si cela fonctionne, ce pourrait être une solution, non ... ?

Pour préciser ma pensée, je pense à quelque chose comme ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim phrase, Nbr_Caract, Liste_caract, Code_caract Nbr_Caract = 3 Liste_caract = Split("é,è,à",",") Code_caract = Split("130,138,133",",") phrase = Inputbox("Saisissez votre phrase") For i = 0 TO nbr_caract - 1 Replace phrase, Liste_caract(i), " & chr(" & Code_Caract(i) & ") & " Next msgbox phrase

Résolu ! IP + Google Speech

:merci: Cashlab de votre intervention, car vous m'avez rappeler à une fonction utile :king:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim i,x,a 
i = InputBox("Entrer un caractère ou une phrase pour obtenir son Code Unicode Correspondant !") 
If i <> "" Then 
For x = 1 To Len(i) 
If x <> Len(i) Then 
a = a & "ChrW(" & AscW(Mid(i,x,1)) & ")" & "&" 
Else 
a = a & "ChrW(" & AscW(Mid(i,x,1)) & ")" 
End if 
Next 
Inputbox "Le Code Unicode Correspondant pour " & qq(i) & " est:",,a 
End If 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function

et j'ai alors résolu ce problème :mouarf: :resolu: :plusser:
Remarque : Le script est enregistré en tant que ANSI et cela a bien fonctionné pour moi. :king:
ce script vous affiche 3 messages box avec 3 langues différentes avec la voix de Google Speech.

Anglais
Français
Arabe

IP + Google speech

Code:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
    Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public,IP
    Dim MessageEN,MessageFR,MessageAR,URLEN,URLFR,URLAR,Copyright
    Copyright = "(2014 © Hackoo)"
    MessageEN = "You are connected to the internet !" & VbCrlf & "Your Public IP Adress is "
    MessageFR = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est "
    MessageAR = ChrW(1571)&ChrW(1606)&ChrW(1578)&ChrW(32)&ChrW(1605)&ChrW(1578)&ChrW(1589)&ChrW(1604)&_
    ChrW(32)&ChrW(1576)&ChrW(1588)&ChrW(1576)&ChrW(1603)&ChrW(1577)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1573)&_
    ChrW(1606)&ChrW(1578)&ChrW(1585)&ChrW(1606)&ChrW(1578)& VbCrlf & "IP "
    URLEN = "http://translate.google.com/translate_tts?tl=en&q=" & MessageEN
    URLFR = "http://translate.google.com/translate_tts?tl=fr&q=" & MessageFR
    URLAR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" & MessageAR
    Titre = "Adresse IP Publique " & Copyright
    URL = "http://monip.org"
    If OnLine("smtp.gmail.com") = True Then 
        Set ie = CreateObject("InternetExplorer.Application")
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        ie.Navigate (URL)
        ie.Visible=False
        DO WHILE ie.busy
            Wscript.Sleep 100
        Loop
        Data = ie.document.documentElement.innertext
        Set objRegex = new RegExp
        objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
        objRegex.Global = False
        objRegex.IgnoreCase = True
        Set Matches = objRegex.Execute(Data)
        For Each Match in Matches
            IP =  Match.Value
            Call NavigateIE(URLEN & IP)
            MsgBox MessageEN & IP,64,Titre
            Call NavigateIE(URLFR & IP)
            MsgBox MessageFR & IP,64,Titre
            Call NavigateIE(URLAR & IP)
            MsgBox MessageAR & IP,64,Titre
        Next
        ie.Quit
        Set ie = Nothing
    Else
        MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
        Exit Sub
    End If
End Sub
'************************************************************************************************************************************************************
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 Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub NavigateIE(URL)
Dim objExplorer 
Set objExplorer = CreateObject("InternetExplorer.Application")
    with objExplorer
            .Navigate(URL)
            .Visible = False
    end with
End Sub
'**********************************************************************************************