Forums XLPages

Excel & VBA Espace Débutants [résolu] modifier le tableau "récupérer données web"

modifier le tableau "récupérer données web"
#1
bassatine
Débutant XLPages

Inscription: 06/05/2010

Messages: 5

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2007
Posté le : 17-05-2010 03h47

Bonjour

Il ya quelques jours,et suite a ma demande d'aide sur ce forum,myDearFriend! a eu l'amabilité de confectionner une application pour la récupération du palmares des chevaux participant au quinté+.

J'ai voulu ,depuis ,y apporter quelques modifications.Hélas,mes récents progres en vba ne m'ont guere permis d'y parvenir.

Une fois de plus je sollicite l'aide de myDearFriend! a qui j'adresse pour l'occasion mes salutations les plus cordiales.


Les modifications en question concernent le tableau"Palmares" que j'aimerais supprimer et ne garder que les huit premieres cellules de la derniere ligne (a partir de la cellule nommée "cumul")et ce pour tous les chevaux de la course dont le nombre pourrait atteindre (20) dans les cas extremes.(voir fichier joint)


avec toute ma gratitude










Pièce jointe:
xlsx exemple.xlsx   [ Taille: 12.39 Ko - Téléchargements: 452 ]
Edité par bassatine le 17/05/2010 08:28:25
"Aux courses, les petits tuyaux font les grandes misères."

Michel Audiard

Hors Ligne
 Rapport   Haut 

Re: modifier le tableau "récupérer données web"
#2
myDearFriend!
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 : 17-05-2010 18h53
Bonjour bassatine,

Tout d'abord, pour rester conforme aux règles des forums en général et te permettre le maximum de chance d'obtenir de l'aide à l'avenir, je te remercie de ne pas adresser tes questions exclusivement à tel ou tel intervenant (même si c'est moi ). En faisant cela, tu perds peut-être la possibilité d'obtenir d'autres propositions d'aide toutes aussi valables et peut être aussi des réponses plus rapides... je ne suis par ailleurs pas forcément toujours dispo.

Ensuite, je te conseille également de mettre à minima un lien sur le sujet précédent pour aider ceux intéressés à appréhender ton problème.
Pour ceux qui veulent comprendre donc, le fichier précédemment réalisé et dont parle bassatine est dans CE FIL.

Cela dit, si j'ai bien interprété ta nouvelle demande, tu trouveras en pièce jointe une façon de faire...

J'ai repris le code précédent et l'ai modifié comme suit :
' myDearFriend!  -  www.mdf-xlpages.com
Option Explicit

Sub Traitement()
Dim vURL As String
    'URL de départ (à adapter au besoin)
    vURL = "http://www2.france-galop.com/fgweb/Do ... m=297&statut=DP"
    RecupChevaux vURL
End Sub

Sub RecupChevaux(vURL As String)
Dim IE As InternetExplorer
Dim sel As HTMLSelectElement
Dim TabChevaux() As String
Dim L As Long, Lmax As Long  'Ajout
Dim i As Byte

'OBJECTIF : Récupérer les éléments de la liste déroulante chevaux (n° de Ref du cheval + Nom du cheval) dans un tableau String
   
    Application.ScreenUpdating = False
    'on ouvre la page web dans IE de façon invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    IE.Navigate vURL
    Do Until IE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    'On stocke les éléments (N° + Nom) dans le tableau de type String redimensionné
    Set sel = IE.Document.getElementById("ctl00$cphContenuCentral$navigation_cheval$ddlChevaux")
    For i = 0 To sel.Length - 1
        ReDim Preserve TabChevaux(1 To 2, 1 To i + 1)
        TabChevaux(1, i + 1) = sel(i).Value
        TabChevaux(2, i + 1) = sel(i).getAdjacentText("afterBegin")
    Next i
    'On ferme IE (devenu inutile)
    IE.Quit
    Application.ScreenUpdating = True
   
'OBJECTIF : On récupère les tableaux Carrière de chaque cheval de la liste dans l'onglet Résultats
    With Sheets("www.mdf-xlpages.com")
        'On efface d'abord les anciennes données de l'onglet Résultats
        .Cells.Delete
       
        Application.ScreenUpdating = False
        'On boucle sur la liste de chevaux stockée pour récupérer les données souhaitées
        For i = 1 To UBound(TabChevaux, 2)
            'Trouver la prochaine ligne libre de l'onglet Résultats
            L = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            'On inscrit le Nom du cheval
            .Cells(L + 2, 1).Value = TabChevaux(2, i)
            'On récupère le tableau de carrière (par requête Web)
            RecupCarriere .Cells(L + 4, 1), TabChevaux(1, i)
        'Ajout : Extraction des seules données importantes -----------------------------------
            Lmax = .Cells(.Rows.Count, 1).End(xlUp).Row
            'Copie des données qui nous intéressent
            .Range(.Cells(Lmax, 1), .Cells(Lmax, 8)).Copy Destination:=.Cells(L + 3, 1)
            'Suppression du surplus
            .Range(.Cells(L + 4, 1), .Cells(Lmax, 1)).EntireRow.Delete
        '-----------------------------------------------------------------------------
        Next i
        Application.ScreenUpdating = True
    End With
    MsgBox "Traitement terminé !  ", vbInformation + vbOKOnly, "myDearFriend!  -  www.mdf-xlpages.com"
End Sub

Sub RecupCarriere(R As Range, Ncheval As String)
Dim vURL As String
    vURL = "http://www2.france-galop.com/fgweb/Do ... =true&idcheval="
    vURL = vURL & Ncheval
    vURL = vURL & "&aaCrse=2010&cSp=P&numCrsePgm=297&statut=DP"
    With R.Parent.QueryTables.Add(Connection:= _
        "URL;" & vURL, Destination:=R)
        .Name = "MaRequete"
        .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 = "ctl00_cphContenuCentral_gvCarriere"   'ici, on cible uniquement la table souhaitée
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub

Cordialement,
Pièce jointe:
zip mDF_Turf2.zip   [ Taille: 16.89 Ko - Téléchargements: 626 ]
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: modifier le tableau "récupérer données web"
#3
bassatine
Débutant XLPages

Inscription: 06/05/2010

Messages: 5

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2007
Posté le : 17-05-2010 19h48
Bonjour  myDearFriend!

Tout d'abord,je te présente mes excuses d'avoir agi de la sorte.Les remarques que tu as relevées sont fondées.A l'avenir ,elles seront respectées.

Le fichier joint répond exactement a ma demande.
Merci pour tout.

Cordialement.
"Aux courses, les petits tuyaux font les grandes misères."

Michel Audiard

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