selection sous menu page WEB

**spiritoftravel** · 14/05/2014, 15h19

Bonjour à vous,
je viens de récupérer un projet excel (son créateur n'étant plus là) qui ne fonctionne plus. fait sous excel 2003 et Xin XP ce projet est obligé de tourner sur excel 2010 et win 7. Pour faire simple, il récupére des données sur deux site intranet de mon entreprise. j'ai un soucis pour atteindre une page qui se trouve en sous menu (voir image ci dessous)

Nom : sousmenu.jpg
Affichages : 342
Taille : 26,5 Ko

voici le code
le soucis viens de "ratMenu 8_4"
merci de votre aide

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
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
Public Function BotIE_BA(ByRef IE As InternetExplorer, ByVal DateBA As String, ByVal PR As String, ByVal Log As String, ByVal Pass As String) As String
''''''''''''''''''''''''''''''''''''''
'Fonction de recherche Base Assistance
''''''''''''''''''''''''''''''''''''''
NbErr = 0
NbErr2 = 0
'Récupération de la liste des trains de la feuille "Général" dans un tableau "virtuel"
'que l'on appelle "TabMarche", qui va nous servir de tampon pendant la recherche
With ThisWorkbook.Worksheets("Général")
    ListMatos = .Range("A6").End(xlDown).Row - 6
    ReDim TabMarche(ListMatos, 2)
    For J = 0 To ListMatos
        TabMarche(J, 0) = .Range("A" & J + 6).Value
    Next J
End With
 
IE.navigate "https://www.int.sncf.fr"
''WaitIE IE
'Lancement de la navigation dans Base Assistance
IE.navigate "http://base-assistance.sncf.fr/"
 
'IE.Visible = False
IE.Visible = True
'on attend que IE charge la page en entier
WaitIE IE
Set IEDoc = IE.document
 
'Bloc de login Base Assistance, permetant de verifier si on est déja connecté
IEDoc.parentWindow.Location.href = "/commun/html/prive/commun/cadrePrincipal.html?time="
Application.Wait DateAdd("s", 2, Now)
If Not IE.LocationURL = "http://base-assistance.sncf.fr/commun/html/prive/commun/cadrePrincipal.html?time=." Then
    If Not IE.LocationURL = "http://base-assistance.sncf.fr/commun/html/prive/commun/cadrePrincipal.html?time=" Then
        'Si ce n'est pas le cas on se connecte avec les éléments renseignés dans la feuille "Général"
        Set InputZoneText = IEDoc.all("j_username")
        InputZoneText.Value = Log
        Set InputZoneText = IEDoc.all("j_password")
        InputZoneText.Value = Pass
        Set InputButton = IEDoc.all("btn_valider")
        InputButton.Click
    End If
End If
 
WaitIE IE
Sleep 2000
 
'Boucle d'attente item 19 "http://base-assistance.sncf.fr/commun/html/prive/navigation/navigationBar.html"
Do Until Not IEDoc.all.Item(18) Is Nothing
    DoEvents
Loop
[B]Set IEDoc2 = IEDoc.all.Item(18)
Do Until Not IEDoc2.all("ratMenu4_8") Is Nothing
    DoEvents
Loop
'Click sur le bouton "Flux voyageurs" du menu "Occupation"
Set InputZoneText = IEDoc2.all("ratMenu4_8")
InputZoneText.Children.Item(0).Click
IE.document.all("ratMenu4_8")
WaitIE IE
'Pause en ms
Sleep 500
''''''''''''''''''''''''''''
'Base assistance est architecturé en plusieurs "Framesets" qui contiennent des "frames"
'en raison de l'utilisation de ce type d'architecture il est nécessaire de rajouter le site
'de base assistance aux sites de confiance dans les paramètres internet du système,
'sinon les frames les plus profondes ne pourront pas être utilisées
''''''''''''''''''''''''''''
'On charge une variable avec la frame qui nous intéresse
On Error GoTo ErrorHandler
Do Until Not IEDoc.frames(2).frames(0).document Is Nothing
    DoEvents
Loop
On Error GoTo 0
Set IEDoc2 = IEDoc.frames(2).frames(0).document
 
'On démarre la boucle de recherche des trains
ValMax = UBound(TabMarche)
For K = 0 To UBound(TabMarche)
    'Bloc de test du bouton annuler
    If WaitBox.Annuler.Cancel = True Then
        Call Annulation(IE)
        Exit Function
    End If
    'Init variables
    FoundD = False
    FoundO = False
    'MAJ WaitBox
    WaitBox.ProgressBar1.Max = ValMax + 1
    WaitBox.ProgressBar1.Value = K + 1
    WaitBox.ProgressBar1.Refresh
    WaitBox.Repaint
    'Attente IE
    'WaitIE IE
    On Error GoTo ErrorHandler
    'On renseigne de la date
    Set InputZoneText = IEDoc2.all("txtDate")
    InputZoneText.Value = DateBA
    'On remplie le champ train
    Set InputZoneText = IEDoc2.all("txtNumero")
    InputZoneText.Value = TabMarche(K, 0)
    On Error GoTo 0
    'On cherche dans la liste des gares notre PR et on récupère son index
    Set InputList = IEDoc2.all("cbGare")
        For Y = 0 To InputList.Options.all.Length - 1
            If InputList.Options.all(Y).innerText = PR Then
                'On selectionne le PR avec l'index
                InputList.Value = InputList.Options.all(Y).Value
                Exit For
            End If
        Next
    'Click du bouton
    On Error GoTo ErrorHandler
    Set InputButton = IEDoc2.getElementsByTagName("INPUT")(8)
    InputButton.Click
    On Error GoTo 0
    'WaitIE IE
    'Attente du chargement de la frame
    Do Until Not IEDoc.frames(2).frames(1).document Is Nothing
        DoEvents
    Loop
    'Pause en ms
    Sleep 100
    On Error GoTo ErrorHandler
    Do Until IEDoc.frames(2).frames(1).document.readyState = "complete"
        'MAJ Waitbox
        WaitBox.Etat2.Caption = "Attente d'Internet Explorer"
        WaitBox.Repaint
        DoEvents
    Loop
    On Error GoTo 0
    'MAJ WaitBox
    WaitBox.Etat2.Caption = "Traitement en cours"
    WaitBox.Repaint
    'Init de la variable de présence train
    Set PresTrain = IEDoc.frames(2).frames(1).document.getElementsByTagName("TR")
    If PresTrain.Length <> 0 Then
        'On verifie si le train recherché à été trouvé
        If InStr(1, PresTrain.Item(3).all(0).innerText, TabMarche(K, 0), vbTextCompare) <> 0 Then
            'Init des variables des gares origine et destination
            GareOBA = IEDoc2.getElementsByTagName("INPUT")(2).Value
            GareDBA = IEDoc2.getElementsByTagName("INPUT")(6).Value
            'Bloc de selection de la gare, on effectue une recherche pour l'origine et la destination
            For Y = 0 To InputList.Options.all.Length - 1
                'Si la gare origine est trouvée on continue ici
                If InputList.Options.all(Y).innerText = GareOBA And FoundO = False Then
                    InputList.Value = InputList.Options.all(Y).Value
                    'Click sur le bouton de recherche
                    InputButton.Click
                    'Attente de chargement de la frame
                    Do Until Not IEDoc.frames(2).frames(1).document Is Nothing
                        DoEvents
                    Loop
                    'Pause en ms
                    Sleep 100
                    On Error GoTo ErrorHandler
                    Do Until IEDoc.frames(2).frames(1).document.readyState = "complete"
                        'MAJ WaitBox
                        WaitBox.Etat2.Caption = "Attente d'Internet Explorer"
                        WaitBox.Repaint
                        DoEvents
                    Loop
                    On Error GoTo 0
                    'MAJ WaitBox
                    WaitBox.Etat2.Caption = "Traitement en cours"
                    WaitBox.Repaint
                    'On inscrit dans notre tableau "TabMarche" la valeur du nombre de personnes montant à l'origine
                    TabMarche(K, 1) = IEDoc.frames(2).frames(1).document.getElementsByTagName("TR").Item(3).all(3).innerText
                    'On memorise le resultat de la recherche de la gare origine
                    FoundO = True
                End If
                'Si la gare destination est trouvée on continue ici
                If InputList.Options.all(Y).innerText = GareDBA And FoundD = False Then
                    InputList.Value = InputList.Options.all(Y).Value
                    'Click sur le bouton de recherche
                    InputButton.Click
                    'Attente de chargement de la frame
                    Do Until Not IEDoc.frames(2).frames(1).document Is Nothing
                        DoEvents
                    Loop
                    'Pause en ms
                    Sleep 100
                    On Error GoTo ErrorHandler
                    Do Until IEDoc.frames(2).frames(1).document.readyState = "complete"
                        'MAJ WaitBox
                        WaitBox.Etat2.Caption = "Attente d'Internet Explorer"
                        WaitBox.Repaint
                        DoEvents
                    Loop
                    On Error GoTo 0
                    'MAJ WaitBox
                    WaitBox.Etat2.Caption = "Traitement en cours"
                    WaitBox.Repaint
                    On Error GoTo ErrorHandler
                    'On inscrit dans notre tableau "TabMarche" la valeur du nombre de personnes descendant à la destination
                    TabMarche(K, 2) = IEDoc.frames(2).frames(1).document.getElementsByTagName("TR").Item(3).all(1).innerText
                    On Error GoTo 0
                    'On memorise le resultat de la recherche de la gare destination
                    FoundD = True
                End If
                'Pour éviter que la boucle continue même après que l'on ai trouvé les OD on sort de la boucle
                'dès que FoundO et FoundD sont vraies
                If FoundO = True And FoundD = True Then Exit For
BypassT:
            On Error GoTo 0
            Next Y
            'Dans cette partie on inscrit une alerte en collonne K si une ou les deux gares sont introuvables
            If FoundO = False And FoundD = True Then
                ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Gare origine (" & GareOBA & ") Introuvable"
            End If
            If FoundD = False And FoundO = True Then
                ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Gare destination (" & GareDBA & ") Introuvable"
            End If
            If FoundD = False And FoundO = False Then
                ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Gares Introuvables"
            End If
        Else
            'Si le train en cours de recherche est différent de celui affiché dans la table de résultat
            'on inscrit une alerte en K
            ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Train " & TabMarche(K, 0) & " Introuvable"
        End If
    Else
        'Si la recherche du train échoue on inscrit une alerte en K
        ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Train " & TabMarche(K, 0) & " Introuvable"
    End If
    'Bloc de test du bouton annuler
    If WaitBox.Annuler.Cancel = True Then
        Call Annulation(IE)
        Exit Function
    End If
Next
'On copie le contenu du tableau "TabMarche" dans la feuille principale
With ThisWorkbook.Worksheets("Général")
    Application.ScreenUpdating = False
    For K = 0 To UBound(TabMarche)
        .Range("F" & K + 6).Value = TabMarche(K, 1)
        .Range("G" & K + 6).Value = TabMarche(K, 2)
    Next
    Application.ScreenUpdating = True
End With
'MAJ WaitBox
WaitBox.ProgressBar1.Max = 1
WaitBox.ProgressBar1.Value = 1
WaitBox.Repaint
 
Exit Function
 
'Gestion d'erreurs de recherche Base assistance
ErrorHandler:
    Select Case Err.Number
    'Gestion de l'erreur 70 : Accès refusé; qui provient d'un problème de vitesse d'execution
    Case 70
        'Pause en ms
        Sleep 200
        'WaitIE IE
        'Retour à la ligne qui à l'origine l'erreur
        Resume
    'Autre problème de vitesse d'execution
    Case 91
        Sleep 200
        'WaitIE IE
        Resume BypassT
    'Erreur de membre introuvable
    Case 461
    NbErr2 = NbErr2 + 1
        'Si cette erreur se répète plus de 2 fois, on arrête la recherche
        If NbErr2 > 2 Then
            Call ProcErrmsg(300, "Erreur de lecture des données!" & vbCrLf & "Redémarrez la macro au " & DateBA, IE)
        Else
            Resume
        End If
    'Gestion d'erreurs autres
    Case Is <> 0
        Sleep 200
        'WaitIE IE
        NbErr = NbErr + 1
        'Si une erreur non identifiée se répète plus de 4 fois, on arrête la recherche
        If NbErr > 4 Then
            Call ProcErrmsg(301, "Occurrences d'erreurs inattendues !" & vbCrLf & "Redémarrez la macro au " & DateBA, IE)
        Else
            Resume
        End If
    End Select
End Function

le code html de la page
j'avais oublié de le placer

Code html :

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

1
2
3
4
5
6
7
8
<DIV style="Z-INDEX: 1000; POSITION: absolute; WIDTH: 365px; HEIGHT: 100px; VISIBILITY: hidden; TOP: 25px; LEFT: 200px" id="ratMenu4" onmouseover="clearTimeout(theID);onLayer=true;SetMenuVisible('ratMenu4','on')" onmouseout="clearTimeout(theID);onLayer=false;TimedClose('ratMenu4','off','.2')">
<TABLE border="1" cellSpacing="1" cellPadding="2">
<TBODY>
<TR>
<TD bgColor="transparent">
<DIV style="BACKGROUND-COLOR: transparent" id="ratMenu4_8" onmouseover="onLayerColor('ratMenu4','','ratMenu4_8')" onmouseout="offLayerColor('ratMenu4','','ratMenu4_8')">
<A class="headermenulink" onclick="loadFluxVoyageurs()" href="http://base-assistance.sncf.fr/commun/html/prive/navigation/navigationBar.html#">Flux de voyageurs</A>
</DIV>

merci à vous

**patricktoulon** · 14/05/2014, 17h40

Bonjour
déjà pour commencer

il doit y avoir un souci avec ceci:

Code :

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

1
2
3
4
IE.navigate "https://www.int.sncf.fr"
''WaitIE IE
'Lancement de la navigation dans Base Assistance
IE.navigate "http://base-assistance.sncf.fr/"

le ie.document correspondra automatiquement au 2 document est ce que tu veux ?

**spiritoftravel** · 15/05/2014, 11h09

Bonjour,
en effet, pourquoi ouvrir deux URL.... je teste déjà cela.
Merci

selection sous menu page WEB

Macros et VBA Excel

Discussions similaires

Partager

Partager