Discussion :

[STW59]

bonjour ,
Hyper débutant en vba

depuis quelques mois je m'inspire de nombreuses lectures et m'initie (très laborieusement ^^) entre autre sur ce super forum
j'ai pris conscience des possibilités qu'offre le vba , malgré mes efforts je n'arrive pas à 'structurer les différentes commandes
j'arrive petit à petit à 'traduire' chaque ligne mais ce n'est pas encore la panacée

je cherche à complémenter un code déjà existant,
qui permet de charger dans un premier temps : les courses de jour associé dans un combo box menu déroulant
ce code fonctionne déjà très bien (d'ailleurs bravo au créateur ,mdf pour le citer)
dans un second temps, en fonction du choix utilisateur combo. un tableau de partants s'incrémente dans un tableau donc dynamique

j'aimerai ajouter 2 feuilles supplémentaire
- une première feuille (ex nom HISTO1) qui profitant d'une variable (en lien hypertexte déjà existante dans la procédure) créerai un tableau reprenant
la liste des courses par cheval par date (en conservant les liens hypertexte nécessaire à la prochaine feuille histo2)
- une seconde feuille (ex nom HISTO2) tenant compte de la précédente permettant de lister dans un nouveau tableau , les éléments de course +détailler

2 difficulté à anticiper
- l’alignement des éléments tableau seraient parfois à recadrer dans les colonnes correspondantes (pour HISTO2)
- la possibilité de se loguer au démarrage de procédure, permet d'obtenir tout l'historique (et non pas seulement les 5 dernières courses)

Voila en gros l'idée , est ce possible ? merci de votre aide

[patricktoulon]

voici un code de depart pour geny qui liste les courses et reunion selon la date avec les lien

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
Dim madate
Public Function recupcodesoource(url)
    Dim ReQ As Object
    Set ReQ = CreateObject("microsoft.xmlhttp")
    With ReQ
        .Open "post", url, False
        .send
        recupcodesoource = .responsetext
    End With
End Function
Sub test2()
    Sheets("liste").Range("A2", Cells(Rows.Count, "d")).Clear
    With CreateObject("htmlfile")
        madate = Date 'CDate("15/07/2018")'mettre la date que l'on veut
        .body.innerhtml = recupcodesoource("http://www.geny.com/reunions-courses-pmu?date=" & Format(madate, "yyyy-mm-dd"))
        i = 1
        For Each elem In .all
            If elem.classname = "yui-gc cartoucheReunion" Then
                i = i + 1:
                With Cells(i, 1)
                    .Value = elem.ChildNodes(0).innertext
                    .Interior.Color = RGB(0, 100, 0): .Font.Color = vbWhite
                Cells(i, 1).Resize(1, 4).MergeCells = True
                End With
            ElseIf elem.classname = "yui-u first nomCourse" Then
                i = i + 1:
                With Cells(i, 1)
                    .Value = elem.innertext
                    .Interior.Color = RGB(230, 255, 230): .Font.Color = vbBlack
                End With
            ElseIf elem.innertext = "partants/stats/prono" Then
                On Error Resume Next
                Cells(i, 2) = "_c" & Split(elem.href, "_c")(1):
                ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:="http://www.geny.com/" & Split(elem.href, "about:/")(1), _
                                           TextToDisplay:="page du tableau chevaux "
 
                'Cells(i, 3) = "http://www.geny.com/" & Split(elem.href, "about:/")(1):
                'Cells(i, 4) = "http://www.geny.com/" & Replace(Split(elem.href, "about:/")(1), "partants-pmu/", "cotes/")
                ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 4), Address:="http://www.geny.com/" & Replace(Split(elem.href, "about:/")(1), "partants-pmu/", "cotes/"), _
                                           TextToDisplay:="page des cotes"
 
                Err.Clear
            End If
        Next
    End With
    Columns("A:D").AutoFit
End Sub

[STW59]

kj