Discussion :

[geracole]

Bonjour,

J'ai ouvert cette discussion sur le forum Excel, n'ayant pas de réponse, je tente ma chance ici, après tout il s'agit de codage html.

Je développe en Excel une appli qui va lire une page Web et qui récupère une image de département et les coordonnées de zones pour les redessiner sur une feuille Excel.

J'arrive à faire tout ceci avec le source :

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
75
76
77
78
79
80
Sub AjoutCarteDpt()
Dim l_Url As String
Dim Sh As Shape, Img As Object
Dim tArea(50), tZone(50), tCoord() As String, nbZone As Integer
Dim texte, nodept, txt As String
Dim area, zone As String
Dim j, k As Single
 
For Each Sh In ActiveSheet.Shapes
    Sh.Delete
Next
 
    [A1] = InputBox("Département")
    ActiveSheet.Range("A1").Select
    Set Img = ActiveSheet.Pictures.Insert("http://s599720764.onlinehome.fr/cartocistes/cartographie" & [A1] & "/images/image0.png")
    Img.Name = "ImageDept"
 
    nodept = Sheets(1).Range("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)
                        tZone(nbZone) = zone
                    End If
                End If
            End If
        End If
    Loop While j > 0
 
    For i = 1 To nbZone
        tCoord = Split(tArea(i), ",")
        posx = CInt(tCoord(UBound(tCoord) - 1))
        posy = CInt(tCoord(UBound(tCoord)))
        With Sheets(1).Shapes.BuildFreeform(msoEditingAuto, posx, posy)
            For j = 0 To UBound(tCoord) - 1 Step 2
                .AddNodes msoSegmentLine, msoEditingAuto, CInt(tCoord(j)), CInt(tCoord(j + 1))
            Next j
            .ConvertToShape.Select
        End With
        Selection.Name = Left(tZone(i), 32)
    Next
 
 End Sub
 
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

Cela marche parfaitement avec la page Savoie mais pas avec celle de l'Isère, les formes dessinées ne sont pas à l'échelle de la carte, importée comme image.
D'où cela vient-il ?
N'étant pas très fort en html, je n'ai pas trouvé la cause du changement d'échelle.

Sur la page affichée depuis le web, c'est Ok mais pas sur ma feuille Excel. En général la carte est trop petite, mais il arrive que ce soit l'inverse et rarement la taille exacte.

Si vous voulez exécuter le code, lors de la demande du département, indiquer 38 pour la page Isère qui pose problème, et 73 pour la Savoie (pour ceux qui ont oublié leurs départements

Merci d'avance.

[psychadelic]

déjà, j'ai pas vraiment l'impression que les 2 cartes soient à la même échelle.

[geracole]

Oui en effet, les cartes sont de tailles différentes. N'empêche que sur la page web, les zones sont parfaitement découpées, alors que quand on utilise les balises coord pour redessiner ces mêmes zones sur une feuille Excel, ce n'est plus le cas.
J'ai donné en exemple les départements 38 et 73 mais c'est vrai pour beaucoup d'autres.

[psychadelic]

je n'en ai aucune idée, j'utilise LibreOffice