Piloter la fenetre windows en vba

**davido84** · 24/06/2016, 19h44

Regarde de ton côté quelle est la combinaison qui fonctionne et je la testerai mais je ne suis pas sûr qu'elle fonctionnera chez moi...

**patricktoulon** · 24/06/2016, 19h48

la combinaison est bonne mais c'est les sleeps qui sont trop court vu que l'on accelere en passant par un webbrowser on peut se permettre de mettre plus de pause
mais malgré ca ca n'ouvre pas le fichier
je vais essayer d'enregistrer un tab de plus pour voir

teste et dis moi si cela enregistre bien dans le dossier des téléchargement ou documents

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
Private Sub UserForm_Activate()
Dim IE As Object, odoc As Object
Dim SC$, F%, Fichier$
 
 On Error GoTo fin
 Fichier = ThisWorkbook.Path & "\VbScript.vbs"
 
 SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
 SC = SC & "Do" & vbCrLf
 SC = SC & "ret = wshShell.AppActivate(""Téléchargement de fichiers"")" & vbCrLf
 SC = SC & "Loop until ret = True" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "if ret = True Then" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "End If"
 
F% = FreeFile
Open Fichier For Output As #F
Print #F, SC
Close #F
SC = """" & Fichier & """"
CreateObject("WScript.Shell").Run SC
    With WebBrowser1
        .Silent = True
        .Navigate "http://www.abcbourse.com/download/historiques.aspx"
        Do: DoEvents: Loop While .ReadyState <> 4    'Or .busy
        ' Page chargée, on continue
        ' modification de la Valeur date
        .Document.getelementsbyname("ctl00$BodyABC$strDateDeb")(0).Value = "26/05/2015"
        .Document.getelementsbyname("ctl00$BodyABC$strDateFin")(0).Value = "26/05/2016"
        'modification du n° de la valeur
        .Document.getelementsbyname("ctl00$BodyABC$txtOneSico")(0).Value = "FR0000120222"
        'activer la coche
        .Document.getelementsbyname("ctl00$BodyABC$oneSico")(0).Click
        'combobox du choix de format de sortie
        .Document.getelementsbyname("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
        ' Clic sur bouton telecharger
        .Document.getelementsbyname("ctl00$BodyABC$Button1")(0).Click
        Do: DoEvents: Loop While .ReadyState <> 4
    End With
 
fin:
Kill Fichier
End Sub

**patricktoulon** · 24/06/2016, 20h13

tiens teste celui la pour l'enregistrement
je fait un kill fichier en cas de multiple tentative

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
Private Sub UserForm_Activate()
Dim IE As Object, odoc As Object
Dim SC$, F%, Fichier$
 ' on test si le fichier existe en cas de tentatives multiple
 ' ca evitera de devoir manipuler les touche supplementaire des fenetre "le fichier existe deja voulez vous le remplacer " etc.....
 If Dir("C:\Users\" & Environ("UserName") & "\Documents\Cotations" & "20150526" & ".csv") <> "" Then
 Kill "C:\Users\" & Environ("UserName") & "\Documents\Cotations" & "20150526" & ".csv"
 End If
 
 On Error GoTo fin
 Fichier = ThisWorkbook.Path & "\VbScript.vbs"
 
 SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
 SC = SC & "Do" & vbCrLf
 SC = SC & "ret = wshShell.AppActivate(""Téléchargement de fichiers"")" & vbCrLf
 SC = SC & "Loop until ret = True" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "if ret = True Then" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 100" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "WScript.Sleep 1000" & vbCrLf
 SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
 SC = SC & "End If"
 
F% = FreeFile
Open Fichier For Output As #F
Print #F, SC
Close #F
SC = """" & Fichier & """"
CreateObject("WScript.Shell").Run SC
    With WebBrowser1
        .Silent = True
        .Navigate "http://www.abcbourse.com/download/historiques.aspx"
        Do: DoEvents: Loop While .ReadyState <> 4    'Or .busy
        ' Page chargée, on continue
        ' modification de la Valeur date
        .Document.getelementsbyname("ctl00$BodyABC$strDateDeb")(0).Value = "26/05/2015"
        .Document.getelementsbyname("ctl00$BodyABC$strDateFin")(0).Value = "26/05/2016"
        'modification du n° de la valeur
        .Document.getelementsbyname("ctl00$BodyABC$txtOneSico")(0).Value = "FR0000120222"
        'activer la coche
        .Document.getelementsbyname("ctl00$BodyABC$oneSico")(0).Click
        'combobox du choix de format de sortie
        .Document.getelementsbyname("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
        ' Clic sur bouton telecharger
        .Document.getelementsbyname("ctl00$BodyABC$Button1")(0).Click
        Do: DoEvents: Loop While .ReadyState <> 4
    End With
 
fin:
Kill Fichier
End Sub

**patricktoulon** · 25/06/2016, 00h34

Re
tiens teste celui la
beep beep le coyote
ca va plaire a Marc il marche a tout les coups chez moi
Nom : demo1.gif
Affichages : 736
Taille : 1,02 Mo

**Marc-L** · 25/06/2016, 01h32

De mon côté sur deux configurations différentes (IE8 & Seven / IE10 & Windows 8)
soit il ne se passe rien soit j'ai la fenêtre pour enregistrer le fichier …
J'en déduis donc que le contrôle a quand même l'air d'être lié à la version d'IE !

Si je m'amusais à coder une version fonctionnant de mon côté,
il y a de fortes chances qu'elle ne fonctionne pas plus du vôtre …

**patricktoulon** · 25/06/2016, 13h18

Bonjour Marc
non pas forcement c'est peut être pas le même ocx c'est tout
je vais faire une recherche sur ce point avant de spéculer

**patricktoulon** · 25/06/2016, 16h10

Bonjour a tous
Marc j'ai fait une recherche et je suis tomber sur une déclaration "withevents" dans un userform
alors en effet avec cette déclaration j' ai les fonctions prédéterminées (voir capture )
Nom : Capture.jpg
Affichages : 526
Taille : 180,2 Ko

Nom : Capture.jpg
Affichages : 526
Taille : 180,2 Ko

il semblerait que pour IE on ai une précision plus importante par rapport aux do:loop que l'on utilise habituellement
j' ai donc fait un test avec un bouton dans un userform
pour les touches simulées j'ai gardé l'idée de davido a une différence prêt!!! il s'autodétruit tout seul
méthode déjà utilisée dans mon google qui par dans les contributions
plus besoins de gérer l'attente de son exécution commandité par VBA

j'aimerait cependant mettre tout ca dans un module classe mais visiblement ca fonctionne pas
voila le code a mettre dans un userform avec un bouton

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
'* on declare un withevents pour avoir les fonction prédeterminées
Private WithEvents oNav As SHDocVw.InternetExplorer
Dim ok As Boolean
Dim bande As Boolean
Private Sub CommandButton1_Click()
    Set oNav = New SHDocVw.InternetExplorer
    oNav.Visible = True
    oNav.Navigate "http://www.abcbourse.com/download/historiques.aspx"
End Sub
Private Sub oNav_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Debug.Print "Document chargé :  " & URL
    ok = True' ok est true des que le document.locationurl est bien l'url de base 
   'les dates 
   oNav.Document.getelementsbyname("ctl00$BodyABC$strDateDeb")(0).Value = "26/05/2015"     
    oNav.Document.getelementsbyname("ctl00$BodyABC$strDateFin")(0).Value = "26/05/2016"
    'modification du n° de la valeur
    oNav.Document.getelementsbyname("ctl00$BodyABC$txtOneSico")(0).Value = "FR0000120222"
    'activer la coche
    oNav.Document.getelementsbyname("ctl00$BodyABC$oneSico")(0).Click
    'combobox du choix de format de sortie
    oNav.Document.getelementsbyname("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
    ' Clic sur bouton telecharger
    oNav.Document.getelementsbyname("ctl00$BodyABC$Button1")(0).Click
    End Sub
 
Private Sub oNav_FileDownload(ByVal ActiveDocument As Boolean, Cancel As Boolean)
    'cette fonction se declanche plusieur fois mais on l'utilise que si ok=true 
If ok = True Then bande = True
    If ok = True And bande = True Then
        Debug.Print "lance les touches"
       ' une seule gestion d'attente en cas de carte graphique molaconne 
    Application.Wait (Now + TimeValue("0:00:01"))
        touche
    End If
End Sub
Sub touche()
    Fichier = ThisWorkbook.Path & "\touche_TAB_ENTER.vbs"
    SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    'SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
    'SC = SC & "WScript.Sleep 300" & vbCrLf
    SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
    SC = SC & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    SC = SC & "objFSO.DeleteFile (""" & Fichier & """)"
    F% = FreeFile
    Open Fichier For Output As #F
    Print #F, SC
    Close #F
    SC = """" & Fichier & """"
    CreateObject("WScript.Shell").Run SC
 End Sub

le fichier touche_TAB_ENTER étant en lui même une petite astuce bien pratique pouvant servir dans bien d'autre application VBA surtout en cas de 64 bits l' api keybd_event causant pas mal de soucis
je compte sur vous pour la classe

**davido84** · 26/06/2016, 12h11

il semblerait que pour IE on ai une précision plus importante par rapport aux do:loop que l'on utilise habituellement

Oui Patrick, c'est la raison pour laquelle j'avais précisé au message 67 que le principal intérêt que j'y voyais était la possibilité de gérer les événements de l'objet IE.

Nous sommes bien d'accord que si tu crées un module de classe le UserForm et le WebBrowser n'ont alors plus d'utilité (sinon tu n'en a pas besoin puisque tu peux gérer les événements directement dans le UserForm via la déclaration WithEvents).

Je vais regarder ce que je peux te proposer mais le problème pour moi est que sur mon ordinateur équipé de Windows 10 + IE11 je vais avoir le même problème que précédemment.
Je vais donc utiliser mon portable (Windows 7+IE9) pour voir si je peux te proposer quelque chose via un module de classe mais laisse moi un peu de temps.

A+

**patricktoulon** · 26/06/2016, 12h22

oui ok y a pas de soucis
oui effectivement dans une classe le userform plus la peine je l'entends bien

PS j'ai fait la même chose avec le webbrowser j'utilise les évènements prédéterminés ca fonctionne aussi a la différence on lance le vbs avant car on a plus la possibilité de reprendre le focus des que la fenêtre est déclenchée

chez moi c'est du 100% sur

W7 starter 32 bits Ie9

widows 7 ultimate 64 et IE 10

Windows 7 premium et IE 11

Nom : demo1.gif
Affichages : 437
Taille : 977,3 Ko

Nom : demo1.gif
Affichages : 437
Taille : 977,3 Ko

**davido84** · 27/06/2016, 00h38

Comme je ne vais pas avoir beaucoup de temps ces prochains jours et histoire de te permettre d'avancer de ton côté, je livre une version expérimentale :

Créer un module de classe nommé clsIE et y placer le code suivant :

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
Option Explicit 
Dim WithEvents IE As InternetExplorer
 
Private Sub Class_Initialize()
On Error Resume Next
IE.Visible = True
 
  If Err.Number <> 0 Then
      Set IE = New InternetExplorer
      IE.Visible = True
  End If
 
End Sub
 
Public Sub Navigate(ByVal URL As String)
  IE.Navigate URL
End Sub
 
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
   If IE.ReadyState = READYSTATE_COMPLETE Then
     If URL = IE.LocationURL Then
       Dim HtmlDoc As HTMLDocument
       Set HtmlDoc = pDisp.Document
       'Debug.Print "IE_DocumentComplete - ReadyState : " & IE.ReadyState
       AbcBourse HtmlDoc
     End If
   End If
End Sub

Dans un module classique :

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
Option Explicit
Dim oIE As clsIE
 
Sub Test()
  Set oIE = New clsIE
  oIE.Navigate "http://www.abcbourse.com/download/historiques.aspx"
End Sub
 
Sub AbcBourse(HtmlDoc As HTMLDocument)
   Dim DateDeb As HTMLInputElement
   Dim DateFin As HTMLInputElement
   Dim txtOneSico As HTMLInputElement
   Dim ABConeSico As HTMLInputElement
   Dim ABCdlFormat As HTMLSelectElement
   Dim ABCButton1 As HTMLInputElement
 
   Set DateDeb = HtmlDoc.getElementsByName("ctl00$BodyABC$strDateDeb")(0)
   DateDeb.Value = "26/05/2015"
   Set DateFin = HtmlDoc.getElementsByName("ctl00$BodyABC$strDateFin")(0)
   DateFin.Value = "26/05/2016"
   Set txtOneSico = HtmlDoc.getElementsByName("ctl00$BodyABC$txtOneSico")(0)
   txtOneSico.Value = "FR0000120222"
   Set ABConeSico = HtmlDoc.getElementsByName("ctl00$BodyABC$oneSico")(0)
   ABConeSico.Click
   Set ABCdlFormat = HtmlDoc.getElementsByName("ctl00$BodyABC$dlFormat")(0)
   ABCdlFormat.Value = "x"
   Set ABCdlFormat = HtmlDoc.getElementsByName("ctl00$BodyABC$Button1")(0)
   ABCdlFormat.Click
 
   Application.Wait (Now + TimeValue("0:00:01"))
   touche
End Sub
 
Sub touche()
Dim Fichier As String, SC As String, F%
   Fichier = ThisWorkbook.Path & "\touche_TAB_ENTER.vbs"
   SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
   SC = SC & "WScript.Sleep 300" & vbCrLf
   SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
   SC = SC & "WScript.Sleep 300" & vbCrLf
   'SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
   'SC = SC & "WScript.Sleep 300" & vbCrLf
   SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
   SC = SC & "WScript.Sleep 300" & vbCrLf
   SC = SC & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
   SC = SC & "objFSO.DeleteFile (""" & Fichier & """)"
    F% = FreeFile
   Open Fichier For Output As #F
   Print #F, SC
   Close #F
   SC = """" & Fichier & """"
   CreateObject("WScript.Shell").Run SC
 End Sub

Chez moi cela fonctionne (Windows7 + IE9) mais à tester et à améliorer de ton côté.
A+

**patricktoulon** · 27/06/2016, 12h37

Bonjour davido

ok j'ai une erreur a abcbourse htmldoc mess:" erreur d'utilisation de la propriété"
ensuite je vois que tu es revenu sur du early binding ca me gène un petit peu

ensuite on a deux module avec des fonction/sub dans les deux ca me gène aussi

voulant quelque chose d'universel c'est pas top

mais ca m'a donné une base dans la compréhension de l'utilisation de l'object en tant que classe
je pofine et reviens

**patricktoulon** · 27/06/2016, 14h32

bon voila
j'ai vu aussi que tu n'utilisait pas l'evenement filedownload alors que c'est lui qui gérait le temps d'attente avant de lancer le vbs
alors voila

teste cette classe
avec dans le module standard ou un bouton sur une feuille ceci:

Code :

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

1
2
3
4
5
6
7
8
9
 
Option Explicit
Dim oIE As clsIE
Sub Testclasse()
   Dim tablo As Variant
 Set oIE = New clsIE
    tablo = Array("20/06/2015", "20/06/2016", "FR0000120222")
    oIE.Navigate "http://www.abcbourse.com/download/historiques.aspx", tablo
End Sub

et maintenant la classe

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
 
Option Explicit
Public WithEvents IE As SHDocVw.InternetExplorer
Dim ok As Boolean
Dim bande As Boolean
Dim tabargmt
Dim sname
Private Sub Class_Initialize()
    On Error Resume Next
    IE.Visible = True
    If Err.Number <> 0 Then
        Set IE = New SHDocVw.InternetExplorer
        IE.Visible = True
    End If
End Sub
Public Sub Navigate(ByVal URL As String, tablo)
    tabargmt = tablo
    IE.Navigate URL
End Sub
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    ok = True
    If IE.ReadyState = 4 Then
        If URL = IE.LocationURL Then
            ok = True
            Dim HtmlDoc As Object
            Set HtmlDoc = IE.Document
            'Debug.Print "IE_DocumentComplete - ReadyState : " & IE.ReadyState
            IE.Document.getElementsByName("ctl00$BodyABC$strDateDeb")(0).Value = tabargmt(0)    '"26/05/2015"    'la variable entre () => afficher la page et faire afficher la source rechercher la variable
            IE.Document.getElementsByName("ctl00$BodyABC$strDateFin")(0).Value = tabargmt(1)    '"26/05/2016"
            'modification du n° de la valeur
            IE.Document.getElementsByName("ctl00$BodyABC$txtOneSico")(0).Value = tabargmt(2)    '"FR0000120222"
            'activer la coche
            IE.Document.getElementsByName("ctl00$BodyABC$oneSico")(0).Click
            'combobox du choix de format de sortie
            IE.Document.getElementsByName("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
            ' Clic sur bouton telecharger
            IE.Document.getElementsByName("ctl00$BodyABC$Button1")(0).Click
        End If
    End If
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub
Private Sub IE_FileDownload(ByVal ActiveDocument As Boolean, Cancel As Boolean)
    Dim i As Long
    If ok = True Then bande = True
    If ok = True And bande = True Then
        Debug.Print "lance les touches"
        touche
    End If
End Sub
Sub touche()
    Dim Fichier As String, SC As String, F%
    Fichier = ThisWorkbook.Path & "\touche_TAB_ENTER.vbs"
    SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    'SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
    'SC = SC & "WScript.Sleep 300" & vbCrLf
    SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    SC = SC & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    SC = SC & "objFSO.DeleteFile (""" & Fichier & """)"
    F% = FreeFile
    Open Fichier For Output As #F
    Print #F, SC
    Close #F
    SC = """" & Fichier & """"
    CreateObject("WScript.Shell").Run SC
sname = ActiveSheet.Name
End Sub

reste a intégrer dans le vbs la fermeture de IE des que le classeur cotations.... est activer pour ne pas avoir a gérer cela dans le déactivate du workbook
j'avais fait ca dans un autre exercice de turfiste je vais essayer de le retrouver

**davido84** · 27/06/2016, 14h53

ok j'ai une erreur a abcbourse htmldoc mess:" erreur d'utilisation de la propriété"

je n'ai pas ce type d'erreur

ensuite je vois que tu es revenu sur du early binding ca me gène un petit peu

c'est mieux tant que l'on est en phase de développement. Cela permet notamment de bénéficier de l'autocomplétion. Une fois la phase de développement terminée tu peux passer en Late Binding

ensuite on a deux module avec des fonction/sub dans les deux ca me gène aussi

voulant quelque chose d'universel c'est pas top

Là c'est juste une base de départ mais de toutes les manières quand tu travailles sur une classe exportable à d'autres projets tu dois distinguer ce qui doit être géré par la classe (procédure d'encapsulage) de ce qui doit être géré par le programme. Donc c'est normal que tu aies les deux modules.
Là ce n'est que le début. Lorsque la procédure que tu veux mettre au point sera bien arrêtée et sûre il sera toujours temps de distinguer ce qui doit être géré par la classe de ce qui doit être géré par le programme.

De toutes les manières si tu ne le fais pas tu ne pourras pas réutiliser ta classe telle quelle dans un autre programme.
Par exemple concernant l'envoi des touches la procédure en elle-même doit être pilotée par la classe par contre la combinaison des touches variera d'un programme à l'autre donc elle devra être indiquée par le programme.

Il faut également étudier les différents événement proposés par l'objet IE pour voir ce à quoi il peuvent servir et dans quel contexte.
Par exemple dans l'exemple que je t'ai fourni la partie de renseignement des champs et de l'envoi des touches est déclenchée par l'événement IE_DocumentComplete mais dans un autre test que j'ai fait j'ai distingué la partie renseignement des champs déclenchée par l'événement IE_DocumentComplete de la partie envoi des touches déclenchée par l'événement IE_DownloadComplete et cela fonctionne également et peut-être que c'est plus adapté (pour l'instant je n'en sais rien).

Tu auras également peut-être besoin d'utiliser des procédure Property si nécessaire.
Bref, si tu veux vraiment créer une classe réutilisable ce n'est que le début !

A+

**patricktoulon** · 27/06/2016, 18h41

bon voila j'ai un peu bossé sur les attentes et la fermeture de IE

maintenant tu a la possibilité d'ouvrir ou télécharger et determiner les date et ISIN
directement des le départ par les argument de la fonction navigate de la classe ( tablo, fiche, True)

tout est gérer dans le vbs
en effet selon comme tu appelle ta classe le script du vbs est différent
voila les deux appel

Code :

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

1
2
Option Explicit
Dim oIE As clsIE

Code :

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

1
2
3
4
5
6
7
Sub Testclasse() 'option ouverture
   Dim tablo As Variant, fiche As String
 Set oIE = New clsIE
    tablo = Array("20/06/2015", "20/06/2016", "FR0000120222")
     fiche = "Cotations" & Format(tablo(0), "yyyymmdd") & ".csv"
 oIE.Navigate "http://www.abcbourse.com/download/historiques.aspx", tablo, fiche
End Sub

Code :

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

1
2
3
4
5
6
7
8
Sub Testclasse2() 'option téléchargement
   Dim tablo As Variant, fiche As String
 Set oIE = New clsIE
    tablo = Array("20/06/2015", "20/06/2016", "FR0000120222")
  fiche = "C:\Users\" & Environ("UserName") & "\Downloads\Cotations" & Format(tablo(0), "yyyymmdd") & ".csv"
  oIE.Navigate "http://www.abcbourse.com/download/historiques.aspx", tablo, fiche, True
'exemple fichier attendu
End Sub

maintenant la classe

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
 
Option Explicit
Public WithEvents IE As SHDocVw.InternetExplorer
Dim ok As Boolean
Dim bande As Boolean
Dim tabargmt
Dim reg
Dim fichierXL
Dim UrLS
Private Sub Class_Initialize()
    On Error Resume Next
    IE.Visible = True
    If Err.Number <> 0 Then
        Set IE = New SHDocVw.InternetExplorer
        IE.Visible = True
    End If
End Sub
Public Sub Navigate(ByVal URL As String, tablo, fiche, Optional R As Boolean = False)
    tabargmt = tablo
    reg = R
    fichierXL = fiche
    UrLS = URL
    IE.Navigate URL
End Sub
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    ok = True
    If IE.ReadyState = 4 Then
        If URL = IE.LocationURL Then
            ok = True
            Dim HtmlDoc As Object
            Set HtmlDoc = IE.Document
            'Debug.Print "IE_DocumentComplete - ReadyState : " & IE.ReadyState
            IE.Document.getElementsByName("ctl00$BodyABC$strDateDeb")(0).Value = tabargmt(0)    '"26/05/2015"    'la variable entre () => afficher la page et faire afficher la source rechercher la variable
            IE.Document.getElementsByName("ctl00$BodyABC$strDateFin")(0).Value = tabargmt(1)    '"26/05/2016"
            'modification du n° de la valeur
            IE.Document.getElementsByName("ctl00$BodyABC$txtOneSico")(0).Value = tabargmt(2)    '"FR0000120222"
            'activer la coche
            IE.Document.getElementsByName("ctl00$BodyABC$oneSico")(0).Click
            'combobox du choix de format de sortie
            IE.Document.getElementsByName("ctl00$BodyABC$dlFormat")(0).selectedIndex = 4
            ' Clic sur bouton telecharger
            IE.Document.getElementsByName("ctl00$BodyABC$Button1")(0).Click
        End If
    End If
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub
Private Sub IE_FileDownload(ByVal ActiveDocument As Boolean, Cancel As Boolean)
    Dim i As Long
    If ok = True Then bande = True
    If ok = True And bande = True Then
        Debug.Print "lance les touches"
        touche
    End If
End Sub
Sub touche()
    Dim fichier As String, SC As String, F%
    fichier = ThisWorkbook.Path & "\touche_TAB_ENTER.vbs"
    'GoTo dem
    SC = "Set wshShell = CreateObject(""WScript.Shell"")" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    ' si on a choisi l'enregistrement on ajoute ces deux lignes(reg=true)
    If reg = True Then
        SC = SC & "wshShell.SendKeys ""{tab}""" & vbCrLf
        SC = SC & "WScript.Sleep 300" & vbCrLf
        SC = SC & "ms=""Téléchargement fichier réussi!!""" & vbCrLf
    End If
    SC = SC & "wshShell.SendKeys ""{enter}""" & vbCrLf
    SC = SC & "WScript.Sleep 300" & vbCrLf
    If reg = True Then
        SC = SC & "Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
        SC = SC & "Do" & vbCrLf
        SC = SC & "i = i + 1" & vbCrLf
        SC = SC & "If fso.FileExists(""" & fichierXL & """) Then ok = True" & vbCrLf
        SC = SC & "Loop Until ok = True Or i = 100000" & vbCrLf
        SC = SC & "WScript.Sleep 300" & vbCrLf
    End If
    ' si l'on a pas choisi l'enregistrement on ajoute cette partie (reg=false)
    If reg = False Then
        SC = SC & "Set objExcel = GetObject(, ""Excel.Application"")" & vbCrLf
        SC = SC & "With objExcel" & vbCrLf
        SC = SC & ".Visible = True" & vbCrLf
        SC = SC & "Do" & vbCrLf
        SC = SC & "i = i + 1" & vbCrLf
        SC = SC & "For Each wb In .Workbooks" & vbCrLf
        SC = SC & "If wb.Name = """ & fichierXL & """ Then ok = True:  Exit For" & vbCrLf
        SC = SC & "Next" & vbCrLf
        SC = SC & "Loop Until ok = True Or i = 100000" & vbCrLf
        SC = SC & "End With" & vbCrLf
        SC = SC & "WScript.Sleep 300" & vbCrLf
        SC = SC & "ms=""ouverture fichier reussi!!""" & vbCrLf
    End If
    SC = SC & " Set objShell = CreateObject(""shell.application"")" & vbCrLf
    SC = SC & "For Each obj In objShell.Windows" & vbCrLf
    SC = SC & "if obj.LocationURL =""" & UrLS & """ then obj.quit" & vbCrLf
    SC = SC & "Next" & vbCrLf
    SC = SC & "If i = 100000 Then" & vbCrLf
    SC = SC & "ms = ""erreur de telechargement """ & vbCrLf
    SC = SC & "End If" & vbCrLf
    SC = SC & "MsgBox ms" & vbCrLf
    SC = SC & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    SC = SC & "objFSO.DeleteFile (""" & fichier & """)"
    F% = FreeFile
    Open fichier For Output As #F
    Print #F, SC
    Close #F
dem:
    SC = """" & fichier & """"
    CreateObject("WScript.Shell").Run SC
End Sub

tu devrait obtenir dans le vbs selon le choix ceci:
vbs de telechargement :

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
Set wshShell = CreateObject("WScript.Shell")
WScript.Sleep 300
wshShell.SendKeys "{tab}"
WScript.Sleep 300
wshShell.SendKeys "{tab}"
WScript.Sleep 300
ms="Téléchargement fichier réussi!!"
wshShell.SendKeys "{enter}"
WScript.Sleep 300
Set fso = CreateObject("Scripting.FileSystemObject")
Do
i = i + 1
If fso.FileExists("C:\Users\polux\Downloads\Cotations20150620.csv") Then ok = True
Loop Until ok = True Or i = 100000
WScript.Sleep 300
 Set objShell = CreateObject("shell.application")
For Each obj In objShell.Windows
if obj.LocationURL ="http://www.abcbourse.com/download/historiques.aspx" then obj.quit
Next
If i = 100000 Then
ms = "erreur de telechargement "
End If
MsgBox ms

mode ouverture

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
Set wshShell = CreateObject("WScript.Shell")
WScript.Sleep 300
wshShell.SendKeys "{tab}"
WScript.Sleep 300
wshShell.SendKeys "{enter}"
WScript.Sleep 300
Set objExcel = GetObject(, "Excel.Application")
With objExcel
.Visible = True
Do
i = i + 1
For Each wb In .Workbooks
If wb.Name = "Cotations20150620.csv" Then ok = True:  Exit For
Next
Loop Until ok = True Or i = 100000
End With
WScript.Sleep 300
ms="ouverture fichier reussi!!"
 Set objShell = CreateObject("shell.application")
For Each obj In objShell.Windows
if obj.LocationURL ="http://www.abcbourse.com/download/historiques.aspx" then obj.quit
Next
If i = 100000 Then
ms = "erreur de telechargement "
End If
MsgBox ms

Voila. Si tu veux je te passe le fichier.

**davido84** · 27/06/2016, 21h47

Oui poste le fichier c'est plus simple.

J'ai fait quelques tests de mon côté sur les différents événements de l'objet IE pour comprendre dans quel ordre ils intervenaient et voir ainsi ceux qui apparaissaient après le remplissage des champs et avant l'envoi des touches et il me semble bien que l'événement IE_DownloadComplete soit déclenché après IE_FileDownload...peut-être une piste à creuser ne serait ce que pour tester.

A+

**patricktoulon** · 27/06/2016, 22h10

voila un fichier nettoyé pour toi

**davido84** · 28/06/2016, 09h11

Pas trop le temps ce matin.
J'ai testé ton fichier sans regarder le code et cela semble fonctionner correctement...quand la fenêtre d'IE s'ouvre.
Je ne sais pas si tu as ce problème de ton côté mais moi si et ce quel que soit le code testé, Cela arrive surtout à l'ouverture du fichier lorsque je lance le code. Il faudra régler cela, quitte à passer par des API si pas d'autres solutions.
J'ai fait un fichier qui utilise l'événement IE_DownloadComplete à la place de IE_FileDownload : teste de ton côté c'est juste pour voir quel événement choisir pour le déclenchement de l'envoi des touches (ce n'est pas finalisé c'est juste pour voir).Si tu places un Debug.Print dans ces 2 événements sans code en plus IE_DownloadComplete se déclenche après IE_FileDownload tout en étant déclenché avant l'apparition du bandeau de téléchargement (ce qui me paraît logique).
A+

**patricktoulon** · 28/06/2016, 11h29

re
Bonjour Davido
j'ai tester ca a l 'air de fonctionner

les apis justement non!!! car trop de différence entre 32 et 64 bits
et puis je l'avais fait il y a au moins deux ans c'est une usine a gaz avec enumwindows , enumchildwondow , findwindows , findwindowhex,etc...........
ca fonctionnait tres bien en 32 bits mais en 64 c'est l'horreur!!!!j'essaierais de le retrouver dans mes archives

le principe etant pas mal fonctionnel reste a le rendre universel (toute url) sans avoir a changer tout le code
c'est pour cela que finalement tu a raison de séparer le renseignement de la page

il faudrait voir histoire de le rendre facile d'utilisation aussi ,d'intégrer dans le initialise de la classe le pointage dynamique des deux références html voir si c'est possible bien entendu

c'est un bon projet ca !!!ca me ramène 2 ans en arrière quand je me suis débattu avec les apis

**davido84** · 28/06/2016, 14h43

les apis justement non!!! car trop de différence entre 32 et 64 bits
et puis je l'avais fait il y a au moins deux ans c'est une usine a gaz...

Pas vraiment :dans le module de classe
En entête :

Code :

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

1
2
3
4
5
6
7
 
#If win64  
   Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#Else
   Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#End If
Const SW_MAXIMIZE = 3

puis dans l'événement IE_BeforeNavigate2 :

Code :

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

1
2
3
4
 
Private Sub IE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
ShowWindow IE.hwnd, SW_MAXIMIZE
End Sub

Pour l'instant cela fonctionne tel quel.
Pour la compatibilité 32/64 bits je m'en occupe.

Maintenant si tu as une autre solution sans API qui fonctionne pas de problème.

A+

**patricktoulon** · 28/06/2016, 14h53

a oui mais ca c'est simplement la fenetre de IE moi je te parle de mon module qui commence a dater d'ailleurs en faisant une recherche approfondi on devrait le retrouver

j'utilisait les api pour cibler:

la fenêtre de telechargement (bandeau pour ie9 10 et 11,fentre pour ie 8)findwindow par le classname et non le string de la caption car il n y en a pas
attente api sleep et do:loop until handle<>0
le handle le du bouton(ouvrir ou telecharger)(api enumchild....,findwindowhex,etc....)en partant du handle trouvé précédemment
attente pareil
api sendmessage pour actionner le bouton

Piloter la fenetre windows en vba

Macros et VBA Excel

Discussions similaires

Partager

Partager