On vient de passer de excel 97 a excel 2010 et mes codes vba ne fonctionnent plus ? a l'aide

**lovlov33** · 02/09/2014, 04h16

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

Invité · 02/09/2014, 09h30

ton application fait référence à des bibliothèque qui n'existe plus! vas dans les référence du projet et supprime tous les lib internet!

Code :

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

1
2
3
4
5
Dim IEDoc As HTMLDocument
Dim InputZoneText As HTMLInputElement
Dim InputCheckBox As HTMLInputElement
Dim InputButton As HTMLInputElement
Dim htmlTabElem() As IHTMLElement

modifies tes déclarations

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
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
Const READYSTATE_COMPLETE = 4
Dim IEDoc As Object
Dim InputZoneText As Object
Dim InputCheckBox As Object
Dim InputButton As Object
Dim htmlTabElem() As Object
Dim Ie As Object
'Declaration pour la fonction getElementsByClassName
 
Dim aElement As Object
Dim FuncElements() As Object
Dim SourceElem As Object
Dim GenericElement As Object
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 Object
 
Public Function BotIE_CHTI(Ie As Object, DTrain As String, DateT As String, TLigne As Integer) As String

Code :

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

1
2
3
sub Test()
set IE=CreateObject("InternetExplorer.application")
end sub

et tout devrait rentrer dans l'ordre!

**issoram** · 02/09/2014, 09h39

Bonjour,

Je viens de voir que Rudupt t'a répondu clairement (donc je laisse tomber ce que je rédigeais). Je pense effectivement qu'avec la mise à jour du code, tout devrait fonctionner.

**lovlov33** · 02/09/2014, 10h48

Merci beaucoup rdurupt pour tes données.
Petite question

Code :

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

1
2
3
4
 
sub Test()
set IE=CreateObject("InternetExplorer.application")
end sub

je le mets ou ce code sur mon vba ?
Désolé je ne suis pas un expert vba, de plus si tu veux bien j'ai un soucis de plus sur cette macro.
Quand je fais l'export de mon fichier via le site interne je suis bloqué avec une fenetre qui s'ouvre en me demandant soit d'ouvrir , enregistrer ou annuler. Comment fait on pour ouvrir automatiquement avec vba cette fenetre, sans qu'il me pose la question?

Merci de ta patience

Invité · 02/09/2014, 10h54

tu as sans doute créer une variable du type InternetExplorer qui ne fonctionne plus maintenant que tu retire les références IE!

Code :

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

dim IE as new InternetExplorer

il faut bien créer une instance de IE puisque devient un objet on utilise CreatObect!

Code :

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

1
2
3
4
5
dim IE as Object
sub Test()
set IE=CreateObject("InternetExplorer.application")
BotIE_CHTI(IE...
end sub

**lovlov33** · 03/09/2014, 00h59

Bonsoir rdurupt,
Voici ma macro que j'execute depuis la feuille 1 de mon classeur Excel.
Dessous en premier lieu tu vas trouvé tous les codes dans le module" Bot Ie"
J'ai bien modifié les references dans ma macro, mais j'ai toujours un soucis.
Je joins mon code , car maintenant il me met comme message "erreur de compilation Variable non definie .
le debogueur pointe sur la ligne reprise en verte

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
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
Const READYSTATE_COMPLETE = 4
Dim IEDoc As Object
Dim InputZoneText As Object
Dim InputCheckBox As Object
Dim InputButton As Object
Dim htmlTabElem() As Object
Dim Ie As Object
 
'Declaration pour la fonction getElementsByClassName
 
Dim aElement As Object
Dim FuncElements() As Object
Dim SourceElem As Object
Dim GenericElement As Object
Dim iElem As Integer

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
Public Function BotIE_CHTI(Ie As Object, DTrain As String, DateT As String, TLigne As Integer) As String
WaitIE Ie

Ie.Navigate "http://chti.sncf.fr/Marche.aspx"
'"http://x64lmwbigf9/chtiV2.0/Marche.aspx"

Ie.Visible = False

'on attend que IE charge la page  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

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
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 = 4
    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

Comme je te l'ai dit je ne sui pas du tout un expert en vba, surtout pas en 2010.
Je te joins les codes que j'ai dans ma feuille 1 de mon classeur, car il y a peut etre un truc qui cloche sur cette formule aussi.
Si tu peux m'aider je te remercie d'avance

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
Public Ie As InternetExplorer
 
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.ActiveSheet
    If .Range("A" & Target.Row).Value <> vbNullString Then
        If Target.Column = 1 And Target.Row > 15 Then
            Set Ie = CreateObject("InternetExplorer.application")
 
            Call BotIE_CHTI(Ie, .Range("A" & Target.Row).Value, .Range("J10").Value, Target.Row)
 
            Ie.Quit
            Set Ie = Nothing
            On Error Resume Next
            ThisWorkbook.ActiveSheet.Range("L" & Target.Row).Value = Time
            ThisWorkbook.ActiveSheet.Range("M" & Target.Row).Value = Date
        End If
    End If
End With
End Sub
 
 
 
 
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Call InitBouton
End Sub

Desolé de te demander tout ça , mais merci beaucoup de ton aide

Invité · 03/09/2014, 13h09

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
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
Const READYSTATE_COMPLETE = 4
Dim IEDoc As Object
Dim InputZoneText As Object
Dim InputCheckBox As Object
Dim InputButton As Object
Dim htmlTabElem() As Object
Public Ie As Object
 
'Declaration pour la fonction getElementsByClassName
 
Dim aElement As Object
Dim FuncElements() As Object
Dim SourceElem As Object
Dim GenericElement As Object
Dim iElem As Integer
Sub test()
Dim Ie As Object
Set Ie = CreateObject("InternetExplorer.application")
BotIE_CHTI Ie, "01/01/2014", "12/01/2014", "25"
End Sub
Public Function BotIE_CHTI(Ie As Object, DTrain As String, DateT As String, TLigne As Integer) As String
 
Dim Check2
Dim ValFin
Ie.Navigate "http://chti.sncf.fr/Marche.aspx"
WaitIE Ie
'"http://x64lmwbigf9/chtiV2.0/Marche.aspx"
 
Ie.Visible = False
 
'on attend que IE charge la page  en entier
WaitIE Ie
 
'Init
Set IEDoc = Ie.Document
Dim Check As Object
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 = Ie.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 Object)
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 = 4
    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
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.ActiveSheet
    If .Range("A" & Target.Row).Value <> vbNullString Then
        If Target.Column = 1 And Target.Row > 15 Then
            Set Ie = CreateObject("InternetExplorer.application")
 
            Call BotIE_CHTI(Ie, .Range("A" & Target.Row).Value, .Range("J10").Value, Target.Row)
 
            Ie.Quit
            Set Ie = Nothing
            On Error Resume Next
            ThisWorkbook.ActiveSheet.Range("L" & Target.Row).Value = Time
            ThisWorkbook.ActiveSheet.Range("M" & Target.Row).Value = Date
        End If
    End If
End With
End Sub

**lovlov33** · 03/09/2014, 13h50

J'essaierai cela ce soir car je travail de nuit en ce moment.
Merci beaucoup de t'interesser a mon cas et surtout d'etre dispo pour m'aider.
Au fait comme je te l'avais specifié dans un de mes messages avant , j'ai aussi un soucis quand je fais l'export des données j'ai une fenetre qui s'ouvre et qui me demande si je veux " ouvrir " , "enregistrer" ou annuler.
Que puis je faire pour l'ouvrir automatiquement avec une macro vba, ou existe t'il une manip sur excel qui zappe cette fenetre.

Merci beaucoup de ta patience et sinon je te tiens au courant de ta macro des que je suis au boulot .

Encore merci

**lovlov33** · 03/09/2014, 21h20

Ca y est j'ai essayé la macro mais cela ne marche pas . Enfin la page internet s'ouvre mais rien ne s'écrit dans la case marche .
Par contre j'ai une fenetre qui s'ouvre et qui me dit /
- Erreur d'éxecution '-2147417848(80010108)':
- Erreur Automation
L'objet invoqué s'est déconnecté de ses clients

En cliquant sur débogage , cela me renvoi a la ligne 116 de ta macro :

Code :

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

Do Until Ie.readystate = READYSTATE_COMPLETE = 4

Que dois je faire ?
Help Me !!!!!!!!!!!!!!!!

Invité · 03/09/2014, 21h36

Code :

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

Do Until Ie.readystate = READYSTATE_COMPLETE

En ce qui concerne l'URL je ne peux pas t'aider IE me dit page introuvable

**lovlov33** · 03/09/2014, 21h49

Meme en changeant le code , j'ai toujours le meme probleme.
Pour ce qui est de l'URL , l'adresse est correcte . Ma page web s'affiche sur le bon site , mais par contre on n'a pas les valeurs qu se mettent dans les cases.
Je comprends pas trop!!!
Serait ce un probleme de config internet ?

**Marc-L** · 04/09/2014, 00h03

Bonsoir !

Envoyé par rdurupt

En ce qui concerne l'URL je ne peux pas t'aider IE me dit page introuvable

Idem, c'est donc de l'intranet, pas consultable en externe …

Pour comprendre, le demandeur doit au minimum lire le tutoriel Interaction avec Internet Explorer via VBA Excel.

Ce ne doit pas être un problème de configuration mais plutôt de compréhension de la structure de la page web …
Et c'est indépendant de la version d'Excel car il s'agit juste de manipuler des objets externes à Excel,
donc c'est le changement de version d'Internet Explorer la cause …

**AlainTech** · 07/09/2014, 19h03

Bonjour,

Regarde le message 66 de cette contribution.

Je parierais que c'est la solution à ton problème.

**lovlov33** · 08/09/2014, 11h04

apres avoir modifié tout ce que vous m'avez dit, ma page intranet s'ouvre bien.
Le seul bemol c'est que rien ne s'ecrit dans les cases correspondantes a mes requetes.
Quelqu'un peut-il m'aider?
A partir de la ligne 44 Set Ie.... j'ai rien qui se met dans les cases correspondantes dans le site intranet

Code

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
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
Const READYSTATE_COMPLETE = 4
Dim IEDoc As Object
Dim InputZoneText As Object
Dim InputCheckBox As Object
Dim InputButton As Object
Dim htmlTabElem() As Object
Public Ie As Object
 
'Declaration pour la fonction getElementsByClassName
 
Dim aElement As Object
Dim FuncElements() As Object
Dim SourceElem As Object
Dim GenericElement As Object
Dim iElem As Integer
Sub test()
Dim Ie As Object
Set ObjIe = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
BotIE_CHTI Ie, "01/01/2014", "12/01/2014", "25"
End Sub
Public Function BotIE_CHTI(Ie As Object, DTrain As String, DateT As String, TLigne As Integer) As String
 
Dim Check2
Dim ValFin
Ie.Navigate "http://chti.sncf.fr/Marche.aspx"
 
WaitIE Ie
 
Ie.Visible = False
 
'on attend que IE charge la page  en entier
WaitIE Ie
 
'Init
Set IEDoc = Ie.Document
Dim Check As Object
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 = Ie.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 Object)
Dim lTimer As Double
Dim pTimeOut As Long
Dim TimeOutM As Boolean
pTimeOut = 10
lTimer = Timer
TimeOutM = False
 
'Sub d'attente Internet Explorer
 
On Error Resume Next
 
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

Encore merci a tous

Invité · 08/09/2014, 11h09

bonjour,
si tu nous fournies le code html de la page nous pourrons peut-être t’apporter des réponses vue que nous n'avons pas accès à cette page!

**Marc-L** · 08/09/2014, 11h14

Sans accès à la page, voir avec le tutoriel, les contributions et les discussions équivalentes de ce forum !

Je suis déjà étonné du fonctionnement du code d'origine, pas mal de trucs bancales …

**lovlov33** · 08/09/2014, 12h18

J'ai été sur le site interne de ma boite ( Le site se nomme Chti)
J'ai été dans outil de develeppement et j'ai trouvé en HTML Ceci:
DOCTYPE html PUBLIC"-//W3C//DTD XHTML 1.0 Transitional//EN" " http://www.w3.org:TR

html1-transitional.dtd"
ou alors
html class=" x-theme-blue ext-strict" id="ext-gen3" xmlns=http://www.w3.org/1999/xhtml".

Si cela vous convient

Marc-L
peux tu m'en dire plus sur mon projet bancale STP

**Marc-L** · 08/09/2014, 12h22

Disons que j'ai bien des doutes mais sans pouvoir accéder à la page …

Mais commence par bien relire ce que Robert t'a demandé !

On vient de passer de excel 97 a excel 2010 et mes codes vba ne fonctionnent plus ? a l'aide

Macros et VBA Excel

Discussions similaires

Partager

Partager