Bonjour,

Voila 3 ans que cette macro fonctionnait a merveille a mon boulot!!
Depuis 1 mois ils nous ont changé les PC et devinez , ma prog VBA ne fonctionne plus.
Je vous glisse mon code , si quelqu'un a une idée je suis preneur, merci d'avance....
J'ai souligné la ou j'ai un probleme, en effet la page internet s'ouvre mais j'ai un bug sur ca , la macro ne va pas plus loin

Please Help me

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
Option Explicit

Private Val1, Val2, T2, DV, DV_DB As Range
Private TFlag, Tc, Result, L1, N, J, K, timeout, ListMatos As Integer
Private LigneDouble As String
Private PresTrain As Object
Private TabMarche() As String

'Declaration MODE INTERNET EXPLORER

Dim IEDoc As HTMLDocument
Dim InputZoneText As HTMLInputElement
Dim InputCheckBox As HTMLInputElement
Dim InputButton As HTMLInputElement
Dim htmlTabElem() As IHTMLElement

'Declaration pour la fonction getElementsByClassName

Dim aElement As IHTMLElement
Dim FuncElements() As IHTMLElement
Dim SourceElem As IHTMLElementCollection
Dim GenericElement As HTMLGenericElement
Dim iElem As Integer

'Declaration pour les variables Base Assistance
Dim PosSillon, ElementD, ValMax, ValFin As Integer
Dim Element, GareOBA, GareDBA As String
Dim Check, Check2 As HTMLObjectElement

Public Function BotIE_CHTI(IE As InternetExplorer, DTrain As String, DateT As String, TLigne As Integer) As String


IE.Navigate "http://chti.sncf.fr/Marche.aspx"

IE.Visible = False

'on attend que IE charge la page en en entier
WaitIE IE

'Init
Set IEDoc = IE.Document

Set Check = IEDoc.all("ctl00$ContentPlaceHolder1$tbLe")
If Not Check Is Nothing Then
Set InputCheckBox = IEDoc.all("ctl00$ContentPlaceHolder1$cbxSite")
If InStr(1, InputCheckBox.outerHTML, "CHECKED") <> 0 Then
InputCheckBox.Click
End If

Set InputCheckBox = IEDoc.all("ctl00$ContentPlaceHolder1$Période").Item(0)
InputCheckBox.Click

Set InputZoneText = IEDoc.all("ctl00$ContentPlaceHolder1$tbLe")

'Ecriture du train recherché dans le champ correspondant
InputZoneText.Value = DateT

Set InputZoneText = IEDoc.all("ctl00$ContentPlaceHolder1$tbMarche")
InputZoneText.Value = DTrain

'Identification du bouton et click
Set Check = IEDoc.all("ctl00$ContentPlaceHolder1$btVisualise")
If Not Check Is Nothing Then
Set InputButton = IEDoc.all("ctl00$ContentPlaceHolder1$btVisualise")
InputButton.Click

Set InputButton = IEDoc.all("ctl00$ContentPlaceHolder1$btnExport")
InputButton.Click
Do Until IEDoc.all("ctl00_ContentPlaceHolder1_lblRecherche").innerText <> vbNullString
DoEvents
Loop
Set Check2 = IEDoc.all("ctl00_ContentPlaceHolder1_gvMarche")
If Not Check2 Is Nothing Then
htmlTabElem = getElementsByClassName(IEDoc.all("ctl00_ContentPlaceHolder1_gvMarche").all.Item(0), "cssRow cssRowMarche", True)
WaitIE IE



With ThisWorkbook.Worksheets("Tampon")
ValFin = .Range("A65536").End(xlUp).Row + 1
Application.ScreenUpdating = False
.Range("A" & ValFin).Value = htmlTabElem(0).all.Item(2).innerText
.Range("B" & ValFin).Value = htmlTabElem(0).all.Item(7).innerText
.Range("C" & ValFin).Value = htmlTabElem(0).all.Item(8).innerText
.Range("D" & ValFin).Value = htmlTabElem(0).all.Item(9).innerText
.Range("E" & ValFin).Value = htmlTabElem(0).all.Item(10).innerText
.Range("F" & ValFin).Value = htmlTabElem(0).all.Item(12).innerText
.Range("G" & ValFin).Value = htmlTabElem(0).all.Item(15).innerText
.Range("H" & ValFin).Value = CDate(DateT)
End With

With ThisWorkbook.ActiveSheet
.Range("B" & TLigne).Value = htmlTabElem(0).all.Item(7).innerText
.Range("C" & TLigne).Value = htmlTabElem(0).all.Item(9).innerText
.Range("D" & TLigne).Value = htmlTabElem(0).all.Item(8).innerText
Application.ScreenUpdating = True
End With

End If
End If
End If
Exit Function

End Function

Public Sub WaitIE(ByRef IE As InternetExplorer)
Dim lTimer As Double
Dim pTimeOut As Long
Dim TimeOutM As Boolean
pTimeOut = 10
lTimer = Timer
TimeOutM = False
'Sub d'attente Internet Explorer
Do Until IE.readyState = READYSTATE_COMPLETE

If (Timer - lTimer) > pTimeOut Then
TimeOutM = True
Exit Do
End If

Loop
If TimeOutM = False Then
Exit Sub
Else
MsgBox "Internet Explorer ou Chti ne répond plus !", vbCritical, "Erreur"
IE.Quit
Set IE = Nothing
End
End If
End Sub