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
| '---------------------------------------------------------------------------------------
' Procedure : Extraction Coordonnées Lambert
' DateTime : 12/12/2008 23:09
' Author : Basé sur le code de Philben - www.developpez.com
' Purpose : Extraction des coordonnées Lambert du PRAS suivant l'adresse
'---------------------------------------------------------------------------------------
Dim IE As SHDocVw.InternetExplorer
Dim CodeSource As HTMLDocument
Dim colHtmlElts As Object
Dim dX, dY As Double
Dim repere, repere1, repere2, repere3, longX, longY As Integer
Dim dRUE As String
Dim IPOS As Byte
Dim i As Object
If IsNull(Me.CP) Then
MsgBox "Veuillez introduire le code postal", vbOKOnly + vbInformation, "ATTENTION"
Me.CP.SetFocus
Exit Sub
End If
If IsNull(Me.Rue) Then
MsgBox "Veuillez introduire le nom de la rue", vbOKOnly + vbInformation, "ATTENTION"
Me.Rue.SetFocus
Exit Sub
End If
If IsNull(Me.N°) Then
MsgBox "Veuillez introduire le numéro de police", vbOKOnly + vbInformation, "ATTENTION"
Me.N°.SetFocus
Exit Sub
End If
DoCmd.Hourglass True
IPOS = InStr(Me.Rue, "/")
dRUE = Left(Me.Rue, IPOS - 1)
'Création de l'URL d'appel, renvoi d'un HTML contenant les informations
Set IE = CreateObject("InternetExplorer.Application")
'If IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE Then
'MsgBox "L'accès à la page internet demandée n'a pu être réalisé." & Chr(10) & "Veuillez vérifier l'état de la connexion à internet et recommencer l'opération.", vbOKOnly + vbExclamation, "ECHEC DE CONNEXION A INTERNET"
'Exit Sub
'End If
IE.Visible = False
'Ouvre la page du PRAS
IE.navigate "http://geowebas1.ci.irisnet.be/PRASAFFECTATIONFR/adrResForm.jsp?" & _
"pst=" & Me.CP.Value & _
"&mun=0" & _
"&str=" & dRUE & _
"&nbr=" & Me.N°.Value & _
"&lng=fr"
'attente fin de chargement
Do Until IE.readyState = 4
DoEvents
Loop
'Récupération du code source
Set CodeSource = IE.Document
Set i = CodeSource.getElementsByTagName("a")
If i.Length = 0 Then
MsgBox "L'adresse renseignée est incomplète ou inexistante sur le site du PRAS.", vbOKOnly + vbExclamation, "PAS DE RESULTAT TROUVE SUR LE SITE DU PRAS"
DoCmd.Hourglass False
Exit Sub
ElseIf i.Length > 1 Then
MsgBox "L'adresse renseignée correspond à plusieurs résultats sur le site du PRAS." & Chr(10) & "Veuillez vous connecter manuellement sur le site du PRAS, encoder l'adresse et sélectionner un des résultats proposés.", vbOKOnly + vbExclamation, "L'ADRESSE CORRESPOND A PLUSIEURS RESULTATS DE RECHERCHE"
DoCmd.Hourglass False
Exit Sub
Else
Set colHtmlElts = CodeSource.getElementsByTagName("a").Item
'Recherche des coordonnées
repere = InStr(colHtmlElts, "zoomTo")
repere1 = InStr(colHtmlElts, "%20")
repere2 = InStr(colHtmlElts, "%20-1")
longX = repere1 - repere - 7
longY = repere2 - repere1 - 3
'Isoler les coordonnées X et Y
If repere Then
dX = Val(Mid$(colHtmlElts, repere + 7, longX))
dY = Val(Mid$(colHtmlElts, repere1 + 3, longY))
End If
Me.Coord_X = dX
Me.Coord_Y = dY
DoCmd.Hourglass False
'fin:
Set CodeSource = Nothing
Me.Type_bien_maison.SetFocus
End If |
A-00] Connexion à un site Web avec récupération partielle du code source d’une page H
Répondre avec citation
. Par contre, sur mon pc personnel, le code coince à la ligne
Partager