Problème avec caractère UTF8

**geracole** · 07/02/2019, 15h11

Bonjour,

J'accède depuis vba à la page web cartographie du Morbihan.
Je décode cette page à la recherche des noms de zones, et je tombe sur ""Pays dâ€™Auray", pour "Pays d'Auray".

Code html :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
        <area shape="poly" coords="305,84,336,33,425,73,391,97,443,136,438,159,391,163,410,184,383,191,366,175,325,190"
 href="../cistesParZone.php?idRegion=14&codeZone=3" alt="Pays de PloÃ«rmel"
        onmouseover="
          document.images['myimagemap'].src=MesImages[3].src;
          document.body.style.cursor='pointer';" 
          />
          <area shape="poly" coords="205,166,200,196,223,193,222,217,196,230,220,366,156,381,104,349,148,302,130,233,170,163,197,150"
 href="../cistesParZone.php?idRegion=14&codeZone=7" alt="Pays dâ€™Auray"
        onmouseover="
          document.images['myimagemap'].src=MesImages[7].src;
          document.body.style.cursor='pointer';"
          />

En vba je récupère le texte, mais dans mon code je ne retrouve pas "Pays dâ€™Auray" mais "Pays dâ??Auray".
Du coup le décodage UTF8 ne donne rien, je conserve "Pays dâ??Auray".
Et si je veux remplacer dâ?? par d' j'obtiens toujours dâ

Plus haut on trouve "Pays de PloÃ«rmel", là le decodage UTF8 marche bien.

DecodeUTF8 est fourni par BILLOT Michel. J'ai codé un autre module pour décoder UTF8 : RemplaceUTF mais le résultat est idem.

Qui peut m'expliquer ce qui cloche, et comment je m'en sors.
Merci.

Code vba :

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
65
66
67
68
69
70
71
72
73
74
Sub DecodeUrl()
Dim l_Url As String
Dim tArea(50) As String, tZone(50) As String, nbZone As Integer
Dim texte As String, noDept As String, txt As String
Dim area As String, zone As String
Dim i As Long, j As Long, k As Long
 
 
    [A1] = "56"
    noDept = [A1]
    l_Url = "http://s599720764.onlinehome.fr/cartocistes/cartographie" & noDept & "/indexOrdi.php?codeRegion=" & noDept & "&codePays=FR"
    texte = GetCodeSource(l_Url)    'avec les balises(format html)
 
' Boucle recherche <area shape="poly" coords=
    j = 1
    Do
        j = InStr(j, texte, "<area shape=""poly"" coords=")
        If j = 0 Then Exit Do
        txt = Mid(texte, j, 200)
        j = j + Len("<area shape=""poly"" coords=") + 1
        k = InStr(j, texte, """")
        If k > 0 Then
            txt = Mid(texte, k, 50) 'Sauter jusqu'à la 1ère zone
            If InStr(1, txt, "href") Then
                nbZone = nbZone + 1
                area = Mid(texte, j, k - j)
                tArea(nbZone) = area
        ' Recherche alt= pour nom de la zone
                j = k
                j = InStr(j, texte, "alt=")
                If j > 0 Then
                    j = j + 5
                    k = InStr(j, texte, """")
                    If k > 0 Then
                        zone = Mid(texte, j, k - j)
            ' Pour debug
                        Range("B" & nbZone) = zone
''                        Range("G" & nbZone) = DecodeUTF8(zone)
                        Range("G" & nbZone) = RemplaceUTF(zone)
                    End If
                End If
            End If
        End If
    Loop While j > 0
 End Sub
Function RemplaceUTF(ByVal chaine As String) As String
ReDim a_remplacer(0 To 29)
ReDim remplacants(0 To 29)
Dim i As Byte
a_remplacer = Array("Ã®", "Ã©", "â†’", "Ãœ", "Ã¹", "Ã¢", "Ã¨", "Ã ", "â€™", "â‚¬", "Â®", "Ã˜", "Â°", "Ã§", "Ã´", _
                  "Â«", "Â»", "Ã»", "Ãª", "â€¦", "/Ã¸", "Ã¸", "Ã€", "Ã‰", "Ãˆ", " Ã ", "Ã–", "Ã«", "â??")
remplacants = Array("î", "é", Chr(26), "Ü", "û", "â", "è", "à", "'", "€", "®", "Ø", "°", "ç", "ô", _
                  Chr(34), Chr(34), "û", "ê", "..", "ø", "ø", "A", "E", "E", " à ", "Ö", "ë", "d'")
For i = 0 To 28
    chaine = Replace(chaine, a_remplacer(i), remplacants(i))
Next i
    RemplaceUTF = chaine
End Function
 
Public Function GetCodeSource(sURL)
Dim Lapage_en_HTML         'variable pour l'object "Microsoft.XMLHTTP"( l'object XML)
    Set Lapage_en_HTML = CreateObject("Microsoft.XMLHTTP")    'instancie l'object
    Lapage_en_HTML.Open "GET", sURL    'ouvre l'url dans l'object
    Lapage_en_HTML.Send
    Do: DoEvents: Loop While Lapage_en_HTML.ReadyState <> 4    'attendre que la page soit chargée
 
    'le code source est dans """"Lapage_en_HTML.ResponseText""""
    'on créé un object "htmlfile"
    With CreateObject("htmlfile")
        'on y ecrit le codesource complet
        .Write Lapage_en_HTML.ResponseText
    End With
    GetCodeSource = Lapage_en_HTML.ResponseText
End Function

**ARTURO83** · 08/02/2019, 07h50

Bonjour,

Essayez ceci

Code :

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

1
2
3
4
a_remplacer = Array("Ã®", "Ã©", "â†’", "Ãœ", "Ã¹", "Ã¢", "Ã¨", "Ã ", "â€™", "â‚¬", "Â®", "Ã˜", "Â°", "Ã§", "Ã´", _
                  "Â«", "Â»", "Ã»", "Ãª", "â€¦", "/Ã¸", "Ã¸", "Ã€", "Ã‰", "Ãˆ", " Ã ", "Ã–", "Ã«", Chr(226))
remplacants = Array("î", "é", Chr(26), "Ü", "û", "â", "è", "à", "'", "€", "®", "Ø", "°", "ç", "ô", _
                  Chr(34), Chr(34), "û", "ê", "..", "ø", "ø", "A", "E", "E", " à ", "Ö", "ë", Chr(146))

Cdlt

**geracole** · 08/02/2019, 08h39

Bonjour,
Oui c'est bon. Merci.
Peux-tu m'expliquer pourquoi le vba reçoit une chaine différente de celle visualisable dans la html.
Les deux ?? ont-ils une signification particulière qu'il faut ignorer ?
Merci encore.

**ARTURO83** · 08/02/2019, 09h29

Je ne me pose pas toutes ces questions.
Dans votre cas, j'ai isolé le caractère incriminé dans une cellule en (C1), et dans la cellule d'à côté, j'ai saisie la formule: =CODE(C1) qui m'a renvoyé le code ascii du caractère soit 226.

Cdlt

Invité · 08/02/2019, 12h18

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
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Sub Test()
Debug.Print Encode_UTF8("âàèéç"), Decode_UTF8("Ã¢Ã Ã¨Ã©Ã§")
End Sub
 
 
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext
 
    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function
Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext
 
    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If
 
    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop
 
    Decode_UTF8 = unitext
End Function
Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
 
    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
 
        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function

Peux-tu m'expliquer pourquoi le vba reçoit une chaine différente de celle visualisable dans la html.

parce que les ceux qui implémente les pages web considère, par facilité , que le navigateur est en UTF8.
Code Ascii en iso à=195 en UTF8 à= 224

Caractère accentués en HTML5:

Car	Html	en français	En Anglais
â	â	a minuscule accent circonflexe	small a, circumflex accent
à	à	a minuscule accent grave	small a, grave accent
é	é	e minuscule accent aigu	small e, acute accent
ê	ê	e minuscule accent circonflexe	small e, circumflex accent
è	è	e minuscule accent grave	small e, grave accent
ë	ë	e minuscule tréma	small e, dieresis or umlaut mark
î	î	i minuscule accent circonflexe	small i, circumflex accent
ï	ï	i minuscule tréma	small i, dieresis or umlaut mark
ô	ô	o minuscule accent circonflexe	small o, circumflex accent
œ	&oelig;	o e minuscule liés	small o e diphthong (ligature)
û	û	u minuscule accent circonflexe	small u, circumflex accent
ù	ù	u minuscule accent grave	small u, grave accent
ü	ü	u minuscule tréma	small u, dieresis or umlaut mark
ç	ç	c cedille minuscule	small c, cedilla
<	<	inférieur à	less than
>	>	supérieur à	greater than
ß	ß	sz minuscule lié Allemand	small sharp s, German (sz ligature)
ø	ø	o minuscule rayé	small o, slash
Ω	Ω	Omega en grec grand O	Omega
Ð	Ð	inférieur à	capital Eth, Icelandic
Ø	Ø	O majuscule rayé	capital O, slash
Þ	Þ	THORN majuscule Islandais	Þ capital THORN, Icelandic
þ	þ	thorn minuscule Islandais	small thorn, Icelandic
Å	Å	a majuscule anneau	capital a, ring

**geracole** · 08/02/2019, 18h06

Merci, je garde ça au chaud.

Problème avec caractère UTF8 [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager