Modification d'un code Vba
#1
Aspirant XLPages

Inscription: 05/10/2011

Messages: 35

Système d'exploitation:
PC
Version Excel utilisée:
2003, 2007
Posté le : 23-10-2011 21h09
Salut à tous,

Didier m'a généreusement concocté un fichier de récupération de données turfiques sur le site de www.geny.com.
Il est excellent et répond parfaitement à mes attentes sauf sur un petit point que je ne lui avait pas soumis :

Je suis obliger d'attendre minuit pour pouvoir importer les courses du lendemain, ce qui m'oblige à travailler tard le soir alors que les courses du lendemain son disponible 48h avant.

y a t'il une solution pour importer les courses du lendemain sans pour autant attendre minuit, merci de votre aide.
Vous trouverez ci joint le fichier en question.

Merci d'avance.



Hors Ligne
Rapport   Haut 

Modification d'un code Vba (fichier joint)
#2
Aspirant XLPages

Inscription: 05/10/2011

Messages: 35

Système d'exploitation:
PC
Version Excel utilisée:
2003, 2007
Posté le : 23-10-2011 21h14
oups, bizarre le fichier n'était pas dans le message.


Hors Ligne
Rapport   Haut 

Modification d'un code Vba (fichier joint)
#3
Aspirant XLPages

Inscription: 05/10/2011

Messages: 35

Système d'exploitation:
PC
Version Excel utilisée:
2003, 2007
Posté le : 23-10-2011 21h17

Pièce jointe:
zip mDF_RecupWeb GenyCom.zip   [ Taille: 26.99 Ko - Téléchargements: 1163 ]
Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba (mDF RecupWeb Geny.com)
#4
Webmestre

Inscription: 18/05/2006
De Saône-et-Loire (71)

Messages: 1539

Système d'exploitation:
PC
Version Excel utilisée:
97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365
Posté le : 24-10-2011 00h21
Bonsoir chakir123, le Forum,

Dans notre fil précédent, celui dans lequel ce fichier « mDF RecupWeb GenyCom.xls » a pris forme, il me semble t'avoir expliqué que si tu souhaitais de l'aide, il convenait à minima de nous donner les bonnes URL et détailler - clairement - la marche à suivre pour accéder aux données cibles...

Pour rappel donc, ici on n'est pas spécialistes de turf en général, et encore moins du site Geny.com... je pense donc que tu auras compris ce qu'il te reste à faire.

Un minimum d'effort chakir123, ce n'est que du bon sens, rien de plus...

Cordialement,

Didier_mDF
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba (mDF RecupWeb Geny.com)
#5
Aspirant XLPages

Inscription: 05/10/2011

Messages: 35

Système d'exploitation:
PC
Version Excel utilisée:
2003, 2007
Posté le : 24-10-2011 10h26
Bonjour à tous,

Excusez-moi, effectivement faut que je précise un peu plus ma demande, désolé.

Alors prenons un exemple concret :
Aujourd'hui je me rend sur le site : http://www.geny.com/

J'arrive sur la page 'accueil du site, je clique sur l'onglet en haut quinté+/Réunion pmu : http://www.geny.com/reunions-courses-pmu

Nous avons là toutes les réunions du jour composé chacune de plusieurs courses.
Jusqu'ici pas de soucis.

Maintenant admettons que je veuille regarder les réunions de demain 25 octobre, nous sommes le 24 octobre:

Je vais dans "calendrier" en haut à droite : http://www.geny.com/reunions-courses-pmu/_d2011-10-24?#

Et je sélectionne la date de mon choix en l'occurence celle de demain 25 octobre 2011 : http://www.geny.com/reunions-courses-pmu?date=2011-10-25

Voilà j'ai toutes mes réunions pour la journée du 25/10/2011 sans attendre minuit.Puis sur le principe du fichier précédemment joint, importer toutes les réunions de cette nouvelle journée.

Une autre solution est de cliquer directement sur la touche "demain" inscrite sous le mot calendrier : http://www.geny.com/reunions-courses-pmu/_d2011-10-25?

C'est certainement plus simple, non?

Vous remerciant et encore une fois de plus excusez pour ne pas avoir donné plus d'éléments lors de mon premier post.

Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba (mDF RecupWeb Geny.com)
#6
Webmestre

Inscription: 18/05/2006
De Saône-et-Loire (71)

Messages: 1539

Système d'exploitation:
PC
Version Excel utilisée:
97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365
Posté le : 24-10-2011 11h56
Bonjour chakir123, le Forum,

Tu vois quand tu veux...

Bon, tu trouveras en pièce jointe une réponse à ta demande.

J'ai modifié le code VBA comme suit :
Option Explicit
'---------------------------------------------------------------------------------------
' Auteur    : Didier FOURGEOT (myDearFriend!)  -  www.mdf-xlpages.com
' Date      : 24/10/2011
' Sujet     : Récup données Web : Geny.com (v1.1)
'---------------------------------------------------------------------------------------
Sub ListeCourses(Optional Dem As Boolean)
Dim IE As InternetExplorer
Dim IEdoc As HTMLDocument
Dim O As Object
Dim vUrl As String, T As String
Dim Lmax As Long, L As Long
    'Prépare la feuille
    Application.StatusBar = "Patientez..."
    ActiveSheet.Range("17:100").Delete
    Application.ScreenUpdating = False
    'URL de départ   http://www.geny.com/reunions-courses-pmu/_d2011-10-25?
    vUrl = "http://www.geny.com/reunions-courses-pmu" & IIf(Dem, Format(Date + 1, "/_\dyyyy-mm-dd?"), "")
    'Ouvre la page web dans IE de façon invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    'Ouvrir la page Web
    IE.Navigate vUrl
    Do Until IE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Set IEdoc = IE.Document
    vUrl = "http://www.geny.com/partants-pmu/"
    'Mémoriser les liens utiles
    With ActiveSheet.ComboBox1
        .Clear
        .ColumnCount = 2
        .BoundColumn = 2
        .Style = fmStyleDropDownList
        .AddItem "< choisir une course >"
        Lmax = IEdoc.Links.Length
        For Each O In IEdoc.Links
            L = L + 1
            Application.StatusBar = "Patientez... " & L * 100 \ Lmax & " %"
            If O.href Like vUrl & "*" Then
                T = Mid(O.href, Len(vUrl) + 1)
                T = Left(T, InStrRev(T, "_") - 1)
                .AddItem T
                .List(.ListCount - 1, 1) = O.href
            End If
        Next O
        .ListIndex = 0
    End With
    'Quitter IE
    Set IEdoc = Nothing
    IE.Quit
    Set IE = Nothing
    Application.ScreenUpdating = True
    MsgBox "Liste mise à jour avec succès !" & vbLf & vbLf & "- Choisissez une course dans la liste," & vbLf & "- Cliquez ensuite sur « Stats Partants »  " & vbLf & "- Puis, patientez ...  ", vbInformation + vbOKOnly, "myDearFriend!  -  www.mdf-xlpages.com"
    Application.StatusBar = False
End Sub

Sub RecupPartants()
Dim Plage As Range
Dim TabTemp As Variant
Dim vUrl As String
Dim DernLign As Long, L As Long, Lmax As Long
Dim DernCol As Integer
    Application.ScreenUpdating = False
    With ActiveSheet
        'Récupère tableau des partants
        .Range("17:100").Delete
        With .ComboBox1
            If .ListIndex < 1 Then Exit Sub
            vUrl = .Value
        End With
        Application.StatusBar = "Patientez..."
        With .QueryTables.Add(Connection:="URL;" & vUrl, Destination:=.Range("B17"))
            .Name = "mDFquery"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "tableau_partants"
            .WebFormatting = xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = False
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        'Récupére la carrière de chaque cheval
        DernCol = .Cells(18, .Columns.Count).End(xlToLeft).Column
        DernLign = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set Plage = .Range(.Cells(19, 2), .Cells(DernLign, DernCol + 3))
        TabTemp = Plage.Value
        Lmax = UBound(TabTemp)
        For L = 1 To Lmax
            Application.StatusBar = "Patientez... " & L * 100 \ Lmax & " %"
            vUrl = Plage.Cells(L, 2).Hyperlinks(1).Address
            RecupCarriere vUrl, DernLign + 1
            TabTemp(L, DernCol) = .Cells(DernLign + 2, 3)
            TabTemp(L, DernCol + 1) = .Cells(DernLign + 2, 4)
            TabTemp(L, DernCol + 2) = .Cells(DernLign + 2, 5)
        Next L
        Plage.Value = TabTemp
        'Mise en forme
        .Range(.Cells(DernLign + 1, 3), .Cells(DernLign + 1, 5)).Copy Destination:=.Cells(Plage(1).Row - 1, DernCol + 1)
        .Range(DernLign + 1 & ":1000").Delete
        .Columns(DernCol).Copy
        .Range(.Cells(1, DernCol + 1), .Cells(1, DernCol + 3)).EntireColumn.PasteSpecial Paste:=xlPasteFormats
        .Cells.Hyperlinks.Delete
        With Plage.Borders()
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        .Cells.EntireColumn.AutoFit
        .Cells(17, 2).Select
    End With
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Beep
End Sub

Sub RecupCarriere(vUrl As String, Lign As Long)
    With ActiveSheet
        .Range(Lign & ":1000").Delete
        With .QueryTables.Add(Connection:="URL;" & vUrl, Destination:=.Cells(Lign, 2))
            .Name = "mDFquery"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingRTF
            .WebTables = "2"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = False
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End With
End Sub

Je pense que ça devrait répondre à ton besoin...

Cordialement,



Pièce jointe:
zip mDF_RecupWeb GenyCom v1.1.zip   [ Taille: 27.42 Ko - Téléchargements: 1596 ]

Didier_mDF
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba (mDF RecupWeb Geny.com)
#7
Aspirant XLPages

Inscription: 05/10/2011

Messages: 35

Système d'exploitation:
PC
Version Excel utilisée:
2003, 2007
Posté le : 24-10-2011 18h47
Oui excuse moi je tâcherais d'être plus vigilant dans mes demandes, promis.
ça rentre tout doucement dans ma petite tête....
Bah écoutes rien à dire sur le fichier c'est exactement ça!

Mille fois merci.


Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba
#8
Débutant XLPages

Inscription: 25/02/2011

Messages: 18

Système d'exploitation:
PC
Version Excel utilisée:
97 ,2003
Posté le : 29-10-2011 21h27
Bonsoir Didier ,
Voilà encore un fichier très pratique , bravo et merci!!
J'ai essayé de modifier code vba pour importer la page statistique: (http://www.geny.com/stats-pmu/) à la place du tableau des partants mais je n'y suis pas arrivé , cela fait tout planter le fichier donc je viens solliciter votre aide.

Merci d'avance et bonne soirée.

Nico.
Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba
#9
Débutant XLPages

Inscription: 20/08/2011

Messages: 8

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 12-01-2014 17h54

Bonjour,
je fais appel à vous pour modifier le fichie rmDF_RecupWeb GenyCom en passant je remercie Didier l’auteur de celui-ci pour son travail.

 

 

Ce qui m’intéresse c’est d’importer les informations dans les dernières performances, qui se trouve dans le même lien de la carrière du cheval :

 

voir fichier projet joint pour vous montrer ce que je souhaite.

En vous remerciant

Cordialement

Pièce jointe:
zip projet.zip   [ Taille: 60.71 Ko - Téléchargements: 643 ]
zip mDF_RecupWeb GenyCom.zip   [ Taille: 26.99 Ko - Téléchargements: 703 ]
Hors Ligne
Rapport   Haut 

Re: Modification d'un code Vba
#10
Débutant XLPages

Inscription: 20/08/2011

Messages: 8

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 13-01-2014 18h56

Bonjour,
Plus d'informations

 

Voici en résumé le fonctionnement du fichier Excel  dont j'aimerai les modifications (les liens pour importer les informations) si on le faisait manuellement aujourd’hui le 13/01/14.
Ouverture du site : http://www.geny.com.

Lorsqu'on arrive sur l'accueil du site on se rend sur la page onglet quinté+/réunions pmu
http://www.geny.com/reunions-courses-pmu

Ensuite il y a toutes les réunions du jour dont nous avons besoin, composée de plusieurs courses. Après il suffit de cliquer sur une course onglet partants/stats/prono  , par exemple aujourd'hui :

lundi : Vincennes (R1)
Début des opérations vers 13:20

Non-partant : 305
1 - Prix de Brionne
2sur4 Multi Tierce Quarte Quinte

http://www.geny.com/partants-pmu/2014 ... u-prix-de-brionne_c582092
On obtient un tableau de partants, que le fichier récupère pour chaque course.

Pour avoir la carrière du cheval il suffit de cliquer sur le nom du cheval par exemple sur le numéro 1 Update  : http://www.geny.com/cheval/update_c582092_h2119686
Capture de ce lien : voir fichier joint cheval 1

Et là nous avons la carrière du cheval, le fichier récupère la synthèse de la carrière et non pas le détail, pour notre exemple ça se limite à ça :

Courues Victoires Places

43             4            8

voir fichier joint cheval 1 a


Ce qui m’intéresse c’est d’importer les informations dans les dernières performances, en rouge sur le tableau qui se trouve dans le même lien de la carrière du cheval :
voir fichier joint cheval 1 b


Fichier d'origine http://www.mdf-xlpages.com/modules/ne ... 19450173&post_id=5040


Ci-joint les fichiers dont le fichier Excel  projet pour vous montrer ce que je souhaite.

En vous remerciant
Cordialement

Pièce jointe:
zip cheval 1.zip   [ Taille: 70.32 Ko - Téléchargements: 631 ]
zip cheval 1 a.zip   [ Taille: 78.12 Ko - Téléchargements: 551 ]
zip cheval 1 b.zip   [ Taille: 63.44 Ko - Téléchargements: 661 ]
zip projet.zip   [ Taille: 69.23 Ko - Téléchargements: 598 ]
Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes