Lancer Requêtes toutes les x mins mais.

**patricktoulon** · 19/02/2016, 22h32

bon j'ai survoler en diagonal et déjà la ligne 43 et 47 me titille
quand a la ligne 28 et 29 ?????
et la 33 incomplète pour la gestion d'attente

**Sebphyto** · 19/02/2016, 22h47

Ok, pour la 43, heu je sais pas, mais si je lance directement le vbs crée çà fonctionne.
et pour la 47, c un commentaire

Oui tu as raison, pour les lignes 28-29, c une erreur de ma part...

et pour la 33, je ne vois pas

**patricktoulon** · 19/02/2016, 22h48

bon en fait ca deraille apres de onn error

Code :

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

 "On Error Resume Next" & vbCrLf & _                    "Chemin = ""F:\TEST VBS EXCEL\Test VBS.xlsm""" & vbCrLf & _

Code :

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

erreur 1 grave :"Set wbExcel = GetObject(Chemin)" & vbCrLf & _  '  ca ca sert a quoi puisque un get object est sensé chercher dans les object ouvert hors le classeur est sensé être fermé

Code :

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

1
2
  "app = ""Test VBS.xlsm""" & vbCrLf & _
                    "Set appExcel = CreateObject(""Excel.Application"")" & vbCrLf & _

ICI!!!!!!!!!!!!! jamais tu l'ouvre ton classeur ?????????????????????????????
appExcel .workbooks.open blablabla

Code :

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

"Workbooks(app).Worksheets(1).Activate" & vbCrLf & _ ici tu active quoi il est pas ouvert  LOL !!!!!!!!!!

Code :

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

1
2
"appExcel.Visible = True" & vbCrLf & _
                    "wbExcel.Worksheets(1).Cells(1,1) = ""fini""" & vbCrLf & _

Code :

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

1
2
  "'appExcel.save()" 'sans cmmentaire hahahaha nan j'arrette 
            Close #x

**Sebphyto** · 19/02/2016, 22h56

Justement pour ce test mon classeur est ouvert....

Et comme de fait, après le classeur sera ouvert avec

Code :

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

appExcel .workbooks.open blablabla

de ce type

Code :

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

1
2
3
4
5
6
7
8
on error resume next
Chemin = "F:\TEST VBS EXCEL\Test VBS.xlsm"
set wbExcel=getobject(Chemin)
if wbExcel is nothing then
   set  appExcel=createobject("Excel.Application")
   Set wbExcel = appExcel.Workbooks.Open(Chemin)
   appExcel.Visible = True
endif

seb

**patricktoulon** · 19/02/2016, 23h01

non ne travaille pas comme ca . met les conditions au reel tout de suite

Code :

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

"'appExcel.save()" 'sans cmmentaire hahahaha nan j'arrette

c'est vrai qu'avec toi il va falloir peut être la sauver l'application

**Sebphyto** · 19/02/2016, 23h04

Ok donc, je part avec un classeur fermé...tu as raison

Mais du coup ça m'intrigue de savoir comment écrire via cette solution dans un classeur déjà ouvert???grrrr

**Sebphyto** · 19/02/2016, 23h09

dit moi si cela correspond

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
Print #x, "Dim IE, Classeur, Feuille, wbExcel, appExcel, app" & vbCrLf & _
                    "Set IE = WScript.CreateObject(""InternetExplorer.Application"")" & vbCrLf & _
                    "IE.Visible = True" & vbCrLf & _
                    "IE.navigate ""http://www.developpez.net/forums/d1567861-3/logiciels/microsoft-office/excel/macros-vba-excel/lancer-requetes-toutes-x-mins/""" & vbCrLf & _
                    "'Attente ouverture IE" & vbCrLf & _
                    "Do While (IE.Busy)" & vbCrLf & _
                    "WScript.Sleep 10" & vbCrLf & _
                    "Loop" & vbCrLf & _
                    "'On laisse IE ouvert 1 min  = 60000 millisec" & vbCrLf & _
                    "WScript.Sleep (500)" & vbCrLf & _
                    "IE.Quit" & vbCrLf & _
                    "On Error Resume Next" & vbCrLf & _
                    "Chemin = ""F:\TEST VBS EXCEL\Test VBS.xlsm""" & vbCrLf & _
                    "set wbExcel=getobject(Chemin)" & vbCrLf & _
                    "Set appExcel = CreateObject(""Excel.Application"")" & vbCrLf & _
                    "Set wbExcel = appExcel.Workbooks.Open(Chemin)" & vbCrLf & _
                    "appExcel.Visible = True" & vbCrLf & _
                    "wbExcel.Worksheets(1).Cells(1,1) = ""fini""" & vbCrLf & _
                    "appExcel.Close"
            Close #x

**patricktoulon** · 20/02/2016, 00h04

la 14 tu la vire
la 19 c'est quit et non close

**Sebphyto** · 20/02/2016, 14h56

Salut Patrick,

J'ai fait ce que tu as dit

Donc si je lance le VBS "Abeille1" (créée par macro), directement çà fonctionne...mais si je passe par la macro "testvbs" avec création de tâche planifiée à +2 min, ça ne fonctionne pas....
La tache planifiée est bien créée car j'ai regardé dans l'histo des tâches et elle apparaît bien...

si je passe par le vbs "TestVBSPat", mon classeur s'ouvre bien, exécute la macro "testvbs", qui crée la tache (cmd)...mais après rien...

Sinon comment fait-on pour supprimer une tache planifiée créée car à chaque fois il demande si je veux la remplacer?
Seb

**Sebphyto** · 21/02/2016, 10h32

bonjour Patrick,
En relisant les posts, je me suis aperçu que je m'égarais de ta proposition initiale:

j'ai pensé donc que au lieu de programmer X taches pour X course
en programmer UNE SEULE!!!!!!!!!
et cette tache ouvrirais le classeur et le mettrait a jour en fonction de l'heure
pour cela il faudrait que tu organise un second tableau en dessous de celui que je créé avec ma version
dans ce tableau il y aurais 2!!!!!!!! colonnes
id et H-X!!!!!!!!!
et dans le workbook open
récupérer le tableau et boucler sur l'heure la plus proche du moment ou il s'ouvre et je te le donne dans le mille
envoyer la requête avec cette heure récupérée
on pourrais même reprendre ton idé de toutes les X minutes
mais en fait il y aurais qu'ne seul tache par temps pour toutes les courses

ca c'était une premiere idée !!!!!!!!!
maintenant il y en a une autre qui pourrait être plus intéressante dans le sens ou on ouvre pas le classeur
c'est inscrire toute les courses dans le vbs créé et lancer par la tache tri dans les id et heure a l'intérieur de lui même
requête et inscription dans un fichier text temporaire jusque au dernier départ
et a tout moment entre 9.30 et le dernier départ quand tu ouvre ce classeur le mettre a jour avec ce fichier text
c'est pas compliqué
et ton ordi souffre beaucoup moins

je fait la même chose avec un vbs qui créé un fichier text dans le quel j'inscrit les données récupérées sous forme de tableaux html formatés qui seront transmis au classeur des sa réouverture
et dans ce vbs même je reprogramme la même tache avec "MO"
ce qui a pour conséquence 1 cmd ,1 vbs ,1 tache d'enregistrée et c'est tout wagadougou!!!!

donc je vais reprendre à zéro

Et reviendrai ver toi
Seb

**patricktoulon** · 21/02/2016, 10h55

re
bonjour
je te donne la direction que j'ai pris vraiment sinon on avancera pas

alors en premier on récupère tout (mon exemplaire )
ensuite on créé 2 array en string a injecter dans vbs

cet array resemblera a ca
18542;1254;8,124,56,12685 etc............ ca représente les id de course
ensuite le 2 eme pour les heure
11.45,12.50,14:00,15:15,15:45 et.......... ca c'est les heures attention dans le même ordre

la première heure doit correspondre a la première id de course dans l'autre array

ensuite tu veux tout les x temps a partir de 9.30
et bien soit fait un string array de ca
9.30,10.00,10.30,11.00 etc.....................
ensuite tu insère chaque item de cet array dans celui des heure a leur place respective
ce qui donne
9.30,10.00,10.30,11.00,11.30,11.45,12.00,12.30,12.50,13.00, etc............

ensuite tu crée le code d'un dico pour le vbs
ce dico aura pour clé les heures et pour item toute les course qui ne sont pas encore parti selon l'heure (de la clé)

ainsi on aura un dico qui
dico(10.00)="12456,1354,12365,17892, ect ....... et cela pour toute les heures et tout ca dans le vbs
dans le vbs selon a quelle heure il se déclenche il choisira les courses dans le dico a mettre a jour

**Sebphyto** · 22/02/2016, 14h27

Bon voici, une première approche avec dico et tablo
dans la 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
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
Function et_que_ce_passe_t_il_sur_ces_hyppodrome()
    Dim Cse As Long, i As Long, mestr As Object, table As Object, code As String
    Dim Heure As String
    Dim Idcourse As String
    Dim dico As Object
    Dim clé, O, n As Long
    Set dico = CreateObject("scripting.dictionary")
    For i = 0 To UBound(tablo) - 1
        code = recupe_html(linkhyppo & tablo(i, 2))
        With CreateObject("htmlfile")
            .body.innerHTML = code
            Set table = .getelementbyid("box_meeting").getelementsbytagname("TABLE")(0)
            Set mestr = table.getelementsbytagname("TR")
 
            For Cse = 1 To mestr.Length - 1
                tablo(i, 2 + Cse) = mestr(Cse).Children(3).innertext 'prix
                tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(5).innertext 'nb partant
                tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & mestr(Cse).Children(6).innertext 'heure dép
                tablo(i, 2 + Cse) = tablo(i, 2 + Cse) & vbCrLf & Split(Split(mestr(Cse).Children(3).Children(0).href, "id=")(1), Chr(34))(0) ' id courses
                Heure = mestr(Cse).Children(6).innertext
                Idcourse = Split(Split(mestr(Cse).Children(3).Children(0).href, "id=")(1), Chr(34))(0)
                If dico.exists(Heure) = False Then dico.Add Heure, Idcourse
                clé = Heure
                'MsgBox dico(clé)
 
            Next
        End With
    Next
    Cells(2, 1).Resize(UBound(tablo), 30) = tablo
 
    [H30].Resize(dico.Count) = Application.Transpose(dico.keys)
    [I30].Resize(dico.Count) = Application.Transpose(dico.items)
'-------------------------------------------------------------------------------------
    'dico vers 2 tablo
'-------------------------------------------------------------------------------------
    ReDim tabHeur(0 To dico.Count)
    ReDim tabId(0 To dico.Count)
    n = 1
    For Each O In dico.keys
        tabHeurDep(0) = "Heures"
        tabHeurDep(n) = O
        tabId(0) = "ID Courses"
        tabId(n) = dico(O)
        n = n + 1
     Next O
 
     [A20].Resize(, dico.Count) = tabHeurDep
     [A21].Resize(, dico.Count) = tabId
'-------------------------------------------------------------------------------------
    'dico vers 1 tablo et tri
'-------------------------------------------------------------------------------------
    ReDim tablo_HeurId(1 To dico.Count, 1 To 2)
    i = 1
    For Each clé In dico.keys
       tablo_HeurId(i, 1) = clé
       tablo_HeurId(i, 2) = dico(clé)
       i = i + 1
     Next clé
     Call Quick(tablo_HeurId, LBound(tablo_HeurId), UBound(tablo_HeurId))
    [A30].Resize(dico.Count, 2).Value2 = tablo_HeurId
 
End Function

pour le tri du tablo "tablo_HeurId" ----> merci à Mr Boisgontier

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
Private Sub Quick(a, LBTab, UBTab) ' Quick sort
Dim ref, Lb, Ub, temp
   ref = a((LBTab + UBTab) \ 2, 1)
   Lb = LBTab: Ub = UBTab
   Do
     Do While a(Lb, 1) < ref: Lb = Lb + 1: Loop
     Do While ref < a(Ub, 1): Ub = Ub - 1: Loop
      If g <= d Then
        temp = a(Lb, 1): a(Lb, 1) = a(Ub, 1): a(Ub, 1) = temp
        temp = a(Lb, 2): a(Lb, 2) = a(Ub, 2): a(Ub, 2) = temp
        Lb = Lb + 1: Ub = Ub - 1
      End If
    Loop While Lb <= Ub
    If Lb < UBTab Then Call Quick(a, Lb, UBTab)
    If LBTab < Ub Then Call Quick(a, LBTab, Ub)
 End Sub

donc en clair j'ai créé :
- un dico
- 2 tablo avec 1 pour les heures et l'autre pour les id
- un tablo à partir du dico tri par quick sort

cela correspond- t-il à une partie de ta demande?

ensuite tu veux tout les x temps a partir de 9.30
et bien soit fait un string array de ca
9.30,10.00,10.30,11.00 etc.....................
ensuite tu insère chaque item de cet array dans celui des heure a leur place respective
ce qui donne
9.30,10.00,10.30,11.00,11.30,11.45,12.00,12.30,12.50,13.00, etc............

il n'y a que cette partie que je ne pige pas bien!!!
en gros tu veux que je fasse un array avec à l'intérieur une heure de 9h30....à....23h30, toutes les 1/2h
puis que j'injecte le tablo_heurDep dedans en passant par un tri croissant.
donc pour l'instant si l'on ne traite qu'une course, je n'ai qu'une heure de départ à insérer-->ok???
et si j'ai plusieurs courses, la totalité.....je ne vois pas bien la finalité....

Si tu veux bien, je souhaite y aller en douceur afin d'assimiler, et de répondre au mieux à ce que tu veux...

Seb

**patricktoulon** · 23/02/2016, 23h33

bon allez je te donne la base si tu arrive a me reduire ce code a 2.5 lignes
c'est assez facile alors voyons voir

Code :

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

1
2
3
4
5
6
7
8
9
10
11
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Add Key:=Range("B13"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Temp").Sort
        .SetRange Range("B13:C74")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

au boulot

**patricktoulon** · 23/02/2016, 23h53

afin de te motiver
voici ce que j'obtiens en moins de 3 secondes pour les bases en demo

dabors le tablo classic comme je te l'avais donné avec pour chaque course
le prix
le nombre de partants
l'heure de depart
le H-3
l'id de la course

ensuite
on obtiens le tableau complet des taches pour toutes les demie heures ainsi que le H-3
en A les heures :en B toute les course qui ne sont pas parties a l'heure en A et le tout dans l'ordre
et tout ca en moins de 3 secondes
Nom : demoingto64 in-out.gif
Affichages : 205
Taille : 862,3 Ko

Nom : demoingto64 in-out.gif
Affichages : 205
Taille : 862,3 Ko

ton cerveau va cracher ses boyaux

**patricktoulon** · 24/02/2016, 21h27

tiens teste

**Sebphyto** · 24/02/2016, 21h41

C'EST GENIAL...

comme tu le dis encore une fois, mon cerveau va fumé...

C très pervers, ce que tu me donnes

je vais u temps soit peu, essayer de l'étudier
Seb

**patricktoulon** · 24/02/2016, 21h47

tu a compris le but de cette base ? tu vois ou je voulais en venir maintenant , la lumière tu la vois

**Sebphyto** · 24/02/2016, 21h51

Et plus j'avance et plus je vois cette lumière au fond de ce tunnel

donc si je comprend bien ceci
Nom : Capture.PNG
Affichages : 255
Taille : 12,5 Ko

servira à créer des taches planifiées, mais il faut créer un vbs en lui injectant les taches de l'image ci-dessus

**patricktoulon** · 24/02/2016, 21h59

maintenant il faut créer le code vbs

tu dois code pour créer du code vbs

ce code vbs devra avoir dedans

les ligne de la liste des taches en dessous la base sur temp

le code doit ce restitué comme ca dans le le vbs

dicotache("09:30:30")=15555|54632|45698|65741| et ainsi de suite avec toutes les lignes

tu devrais savoir faire ca maintenant non.?
dis moi oui ou non