[XL-2003] Probléme macro recup web-format date [Résolu]

[koni77]

Bonjour le forum ,
J'ai un problème au niveau de mon code vba ,ce code permet la récupération d'informations sur le web , mais je rencontre un problème avec une donnée concernant le format date donc après plusieurs essais de modifications que j'ai vu sur le net concernant les dates , je n'ai trouvé aucune solution donc je viens sollicité l' aide du forum.
Merci d'avance ,
Nico.
(Je vous met le code VBA en entier sachant que mon problème se situe tout à la fin ). ou même le fichier si vous le souhaitez pour que cela soit plus clair?

Code :

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
Sub Traitement()
Dim vUrl As String
Dim D As String, NumCourse As String
    With Sheets("Accueil")
        D = .Range("E2").Text
        NumCourse = .ComboBox1.Text
    End With
    If Not IsNumeric(NumCourse) Then Exit Sub
    'URL de départ
    vUrl = "http://www.pmu.fr/pmu/servlet/pmu.web.servlet.www.infos.PerformancesDetaillesServlet?dd=" _
            & D & "&idc=" & NumCourse & "&np=1&ppd=0"
    'Traiter
    RecupChevaux vUrl
End Sub
 
Private Sub RecupChevaux(ByVal vUrl As String)
Dim IE As InternetExplorer
Dim O As Object, OI As Object, OIS As Object
Dim L As Long
 
    'Ouvre la page web dans IE de façon invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    'RAZ de la feuille
    ActiveSheet.Cells.Delete
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'Boucle sur l'ensemble des partants
    Do
        If vUrl = "" Then
            'Bouton "Suivant" sur la page Web ?
            For Each OI In IE.Document.Links
                If OI.Title = "Suivant" Then
                    vUrl = OI.href
                End If
            Next OI
        End If
        If vUrl = "" Then Exit Do   'Sortir à la fin
        'Ouvrir la page Web
        IE.Navigate vUrl
        Do Until IE.ReadyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        'Détermine première ligne libre
        L = Cells(Rows.Count, 1).End(xlUp).Row + 3
        'Récup Nom du partant
        Set O = IE.Document.getElementsByTagName("H1")
        For Each OI In O
            L = L + 1
            With Cells(L, 1)
                .Value = OI.innerText
                .Font.Bold = True
                Application.StatusBar = .Value
            End With
        Next OI
        'Récup Détail du partant
        Set O = IE.Document.getElementsByTagName("P")
        For Each OI In O
            If OI.innerText <> " Retour à l'accueil de pmu.fr" Then
                Set OIS = OI.getElementsByTagName("span")
                L = L + 1
                With Cells(L, 1)
                    .Value = OIS.Item(0).innerText
                End With
                With Cells(L, 2)
                    .Value = OIS.Item(1).innerText
                End With
            End If
        Next OI
        L = L + 1
        Cells(L, 1) = "Gains 6 dernières courses"
        Cells(L, 2).Value = RecupPlusDetails(L, vUrl)
        vUrl = ""
    Loop
    Columns(1).AutoFit
    ActiveSheet.UsedRange.HorizontalAlignment = xlLeft
    Application.ScreenUpdating = True
    'Fermer IE
    IE.Quit
    Set IE = Nothing
    Application.StatusBar = False
End Sub
 
Private Function RecupPlusDetails(Lign As Long, vUrl As String) As String
Dim T As String
Dim L As Byte
    With Sheets("Tempo")
        .Cells.Delete
        With .QueryTables.Add(Connection:="URL;" & vUrl, Destination:=.Cells(1, 1))
            .Name = "LaRequete"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "1"
            .WebFormatting = xlWebFormattingNone ' xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = True
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
            .Delete
        End With
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 3).Value) & "-" 'Recup Allocation
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 6).Value) & "-" ' recup Gains
        Next L
        RecupPlusDetails = Left(T, Len(T) - 2)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 1).Value) & "-" ' Recup Nb Partants
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        [B]For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 1).Value) & "-" ' >>>>> Recup Date derniére course ( probléme) <<<<<<<<<<<<
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
    End With
End Function

[bbil]

Envoyé par koni77

...(Je vous met le code VBA en entier sachant que mon problème se situe tout à la fin ). ou même le fichier si vous le souhaitez pour que cela soit plus clair?....

non pas besoin de fichier il y as déjà beaucoup trop de code .. tu aurais pu commencer à cerner le problème ..
Par contre tu as oublié de dire quel était ton problème !

[koni77]

Bonjour bbil ,
"Je vous met le code VBA en entier sachant que mon problème se situe tout à la fin" c'est pour le contexte que j'ai mis tout le code et j'avais mis en gras le problème se situant tout à la fin mais cela est enlevé maintenant.....
"tu aurais pu commencer à cerner le problème" j'ai bien essayé mais je n'ai pas la solution , je sais juste que quand j'envoie le traitement de la récupération web la date ne s'affiche pas en entier dans mon tableau mais seulement le jour.... c'est surement à cause du bout de code que j'avais mis en gras....

[bbil]

Pour nous aider à débugger :

Code :

1
2
3
4
5
     T = T & Val(.Cells(L * 3 + 1, 1).Value) & "-" ' >>>>> Recup Date derniére course ( probléme) <<<<<<<<<<<<
        Next L
Debug.print T
Debug.print .Cells(1*3+1,1).Address & " a " & .Cells(1*6+1,1).Address 
Stop 'Résultat dans fenêtre exécution CTRL+G

dit nous ce que tu trouve dans la fenêtre exécution ... ainsi que dans les ta feuilles excel aux adresses affichées dans cette fenêtre exécution.

[koni77]

Voilà ce qu'il me met : 27000-30000-60000-55000-55000-55000-13500-3000-3000-0-27500-8250-6-6-12-13-8-8-3-17-19-28-18-17-
$A$4 a $A$7

[MattChess]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Function RecupPlusDetails(Lign As Long, vUrl As String) As String
Dim T As String
Dim L As Byte
    With Sheets("Tempo")
'...
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 3).Value) & "-" 'Recup Allocation
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 6).Value) & "-" ' recup Gains
        Next L
        RecupPlusDetails = Left(T, Len(T) - 2)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 1).Value) & "-" ' Recup Nb Partants
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 1).Value) & "-" ' Recup Date derniére course ( problème) 
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
    End With
End Function

Les variables T et L sont sur une seule lettre.
Renommez chaque variable en un nom significatif sur plus de trois lettres tel que indRow s'il s'agit de rangée ou indCol s'il s'agit de colonne.

Tous les résultats en rouge sont perdus puisque on réutilise le même nom de fonction RecupPlusDetails() en partie gauche du signe d'affectation "=".
Autrement dit on peut mettre en commentaire les lignes en rouge. Cela ne changera pas le résultat final.
Indiquez l'objectif de RecupPlusDetails() et le résultat attendu.

Définir, par des constantes nommées, les rangées et colonnes clés de la feuille Tempo.
Exemple :

Code :

1
2
3
4
Public Const colRecupGains = 1 ' La première colonne sert pour la Recup Nb Partants
Public Const colDateLastHorseRace = 1 ' Colonne Recup Date dernière course
Public Const colRecupAllocation = 3 ' Colonne Recup Allocation
Public Const colRecupGains = colRecupAllocation + 3 ' Colonne Recup Gains

Cela devrait faire apparaître le bug explicitement.
A-t-on la colonne Recup Gains et la colonne Date de dernière course sur la même colonne ?
___________

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert ci-dessous.

[koni77]

Merci de ta réponse MattChess , oui "Recup Gains et la Date de dernière course" sont sur la même colonne.L’exécution des macros se fait parfaitement bien , je tient à le préciser.

[MattChess]

Ok, colDateLastHorseRace = colRecupGains = 1

Ce n'est pas trop le classeur RecupWebMDF.xls qui peut aider mais comment l'utiliser.
On n'a aucune idée qu'est-ce qu'il y a en E2 pour la valeur D sur une seule lettre ce qui fait qu'il est impossible de savoir qu'est-ce que D à part être la quatrième lettre de l'alphabet. Renommez D en un nom significatif.

NumCourse est explicite mais on ne sait pas quel n° de course on peut donner.

Répondre à la question sur l'objectif de RecupPlusDetails() puisqu'il reste au moins les 3 bugs en rouge dans le message #6.
Détailler le contexte du message #5 et ce qui est réellement attendu comme résultat de RecupPlusDetails().
___________

Si la discussion est résolue, vous pouvez cliquer sur le bouton

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert ci-dessous.

[koni77]

Le fichier permet la recuperation d'information web sur les chevaux : gains en victoire , gain en place , derniére places , nombres de courses courue , nombres de course gagné , nombre de course placé , dernier gain , nombres de partant , montant des allocation et dates des courses...... voilà son objectif mais je pense que ça ne va pas vous aider plus que ça.....

[MattChess]

Cette réponse est trop générale. Il faut du concret :
D = "..." ' Chaîne en E2 dans la feuille Acceuil
NumCourse = NNN
RecupPlusDetails = "..." ' selon le contexte du bug que vous avez indiqué en message #5

Qu'est-ce que la fonction RecupPlusDetails() retourne ?
Qu'est-ce que vous voudriez que RecupPlusDetails() retourne ?

[koni77]

D= date du jour que je rentre en E2
Numcourse= les numéro des courses télécharger selon la date du jour
RecupPlusDetails = dejà explique place , gain....

Pour etre clair j'ai 21/08/2011 dans la recuperation des données et lors du traitement je me retrouve avec juste 21.

[koni77]

"C'est le numéro dont on a besoin, pas de l'explication." Le numéro est inutile est ne rentre pas dans le code et je ne peux vous l'indiquez puisqu'il change tout les jours d’après le site......
"On n'est pas devant le débogueur. Mais vous si. " Aucun problème d’exécution de macro comme je l'ai dit , rien ne bug , j'ai juste un problème de format lors de la recopie des dates des dernière courses effectué par les chevaux. après je ne peux pas dire exactement la valeur obtenue et la valeur souhaitez vue que cela dépend des chevaux en courses...
Ce que je souhaitais savoir c'est ce qu'on met pour en quelque sorte copier , coller une date car là c'est en .Value et ça ne marche pas.

[bbil]

Envoyé par koni77

Voilà ce qu'il me met : 27000-30000-60000-55000-55000-55000-13500-3000-3000-0-27500-8250-6-6-12-13-8-8-3-17-19-28-18-17-
$A$4 a $A$7

et donc cela est les infos disponibles à l'endroit ou tu nous as signalé le problème.. , je vois pas la date la vois tu ? tu nous as pas donné les valeurs contenues dans les cellules A4 à A7....

ou est la date ...? ou doit tu la retrouver à la fin de ton code (l'endroit ou tu as 21...) .?

[MattChess]

Envoyé par koni77

Ce que je souhaitais savoir c'est ce qu'on met pour en quelque sorte copier , coller une date car là c'est en .Value et ça ne marche pas.

Pour accéder à une date dans une cellule d'une feuille, on définit les constantes de rangée et de colonne où trouver la première date.
Voir ligne 4 la constante rowReleve et ligne 5 la constante colDate.
Dans le programme OnOffPeak(), on lit la cellule contenant la date par :

Code :

1
2
Debug.Print Cells(rowReleve, colDate) ' Affiche la date dans la fenêtre d'Exécution immédiate (Ctrl+G)
' Cette date est contenue dans la cellule rowReleve, coLDate

Voir ligne 29, le commentaire : ' Date du relevé.

Envoyé par koni77

j'ai 21/08/2011 dans la recuperation des données

Où ? Dans quelle cellule : rangée et colonne ? E2 ?

Envoyé par koni77

et lors du traitement je me retrouve avec juste 21.

Cela n'aide pas de dire "je". Préférez un nom de variable = une valeur ' un commentaire :

Code :

1
2
3
4
L = 6 ' indice final de boucle sur les 6 courses
' La chaîne T concatène Allocation + Gains + Nb Partants + Date dernière course séparés par "-"
T = "27000-30000-60000-55000-55000-55000-13500-3000-3000-0-27500-8250-6-6-12-13-8-8-3-17-19-28-18-17-"
RecupPlusDetails = T sans le "-" final ' Chaîne retournée par la fonction RecupPlusDetails()

Si vous vous retrouvez avec uniquement la chaîne de caractère "21" c'est :

• Soit à cause d'une erreur sur les coordonnées dûe à l'absence de déclaration de constantes définissant à partir de quelle rangée et quelle colonne on trouve la première date et la constante de pas ou incrément pour trouver la date suivante.
• Soit à cause du Web Query qui ne retrouve pas les dates des courses sur le site Web.
• Soit à cause du Web Query qui ne place pas les dates à l'endroit souhaité sur la feuille.

Pour chacune des six courses, L = 1 to 6 :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Private Function RecupPlusDetails(Lign As Long, vUrl As String) As String
'...
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 1).Value) & "-" ' Recup Nb Partants
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 1).Value) & "-" ' Recup Date derniére course ( probléme)
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1) ' Enlève le dernier "-"
    End With
End Function

On voit un décalage d'une seule rangée entre la récupération du Nb Partants et Date dernière course.
Autrement dit vous récupérez Date dernière course au-dessus d'un Nb Partants dans la même première colonne.

Code :

1
2
3
4
5
6
7
8
L1C1:
L2C1:
L3C1:
L4C1: Date dernière course 1
L5C1: Nb Partants 1
L6C1:
L7C1: Date dernière course 2
L8C1: Nb Partants 2

Donnez la première colonne de la feuille Tempo sous une forme analogue entre les balises [code] et [/code].

Dans la trace, vous indiquez :

Envoyé par koni77

Voilà ce qu'il me met : 27000-30000-60000-55000-55000-55000-13500-3000-3000-0-27500-8250-6-6-12-13-8-8-3-17-19-28-18-17-
$A$4 a $A$7

En découpant par paquet de 6 courses, on peut présenter ces données sous la forme :

Code :

1
2
3
4
Allocation : 27000-30000-60000-55000-55000-55000-
Gains : 13500-3000-3000-0-27500-8250-
Nb Partants : 6-6-12-13-8-8-
Date dernière course : 3-17-19-28-18-17-

Les trois RecupPlusDetails = Left(T, Len(T) - 1) qui enlève le séparateur "-" final en ligne 117, 121 et 125 ne servent à rien.
Seul le dernier en ligne 129 est pris en compte pour le résultat final :

Code :

RecupPlusDetails = "...6-6-12-13-8-8-3-17-19-28-18-17" ' Chaîne finale retournée par la fonction RecupPlusDetails()

La partie finale en rouge de cette chaîne de caractère ne ressemble pas à la concaténation de 6 dates.

A vous de voir s'il s'agit de Nb Partants. Dans ce cas les indices de rangés soulignés dans l'extrait de code sont à mettre au point.
___________

Si la discussion est résolue, vous pouvez cliquer sur le bouton

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert ci-dessous.

[koni77]

Bonjour c'est bon cela fonctionne finalement j'y suis arrivée suffisait d'utiliser Cdate(). Donc cela me donne

Code :

1
2
3
4
   For L = 1 To 1
            T = T & CDate(.Cells(L * 3 + 1, 1).Value) & "-" ' Recup Date derniére course
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)