Forums XLPages

Excel & VBA Espace Débutants [résolu] Lister ID.

Lister ID.
#1
gmh
Aspirant XLPages

Inscription: 20/05/2010

Messages: 21

Système d'exploitation:
PC
Version Excel utilisée:
2003,2007
Posté le : 26-05-2010 20h24
Bonjour,
Peut on écrire un code VBA à partir d'un lien web, pour lister tous les "IDC" du jour et les importer dans une feuille excel en A1.
Cordialement
gmh

Pièce jointe:
xls idc.xls   [ Taille: 17.50 Ko - Téléchargements: 756 ]
Hors Ligne
 Rapport   Haut 

Re: Lister ID.
#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 : 27-05-2010 01h42
Bonsoir gmh, le Forum,

Je pense que cette fois, j'entrevois où tu souhaites en venir...

Aussi, en pièce jointe, tu trouveras une interprétation de ce que je pense avoir compris.

J'ai donc repris le fichier de notre précédent fil de discussions sur ce même sujet, et j'ai remplacé le numéro de course demandé en cellule E4 par une liste de choix qui est automatiquement mise à jour en déclenchant le bouton "MAJ liste".

Pour gérer cette liste, j'ai ajouté le module de code suivant :
Option Explicit
'---------------------------------------------------------------------------------------
' Auteur    : Didier FOURGEOT (myDearFriend!)  -  www.mdf-xlpages.com
' Date      : 27/05/2010
' Sujet     : Récup données Web PMU
'---------------------------------------------------------------------------------------
Sub ListeCourses()
Dim IE As InternetExplorer
Dim IEdoc As HTMLDocument
Dim O As Object
Dim ColReunions As New Collection, ColCourses As New Collection
Dim V As Variant
Dim vURL As String, vID As String, vReunion As String
Dim L As Byte

    'URL de départ
    vURL = "http://www.pmu.fr/turf/" & Sheets("Accueil").Range("E2").Text & "/index.html"
    'Ouvre la page web dans IE de façon invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    Application.ScreenUpdating = False
    'Ouvrir la page Web
    IE.Navigate vURL
    Do Until IE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Set IEdoc = IE.Document
    'Mémoriser les liens des pages de Réunion
    For Each O In IEdoc.Links
        If O.onclick Like "*afficheReunionCalendrier(*" Then
            ColReunions.Add O.href & "|" & O.innerText
        End If
    Next O
    'Pour chaque Réunion
    For L = 1 To ColReunions.Count
        'Ouvrir la page web
        IE.Navigate Split(ColReunions(L), "|")(0)
        Do Until IE.ReadyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        'Récupérer les numéros ID et nom de chaque course
        Set IEdoc = IE.Document
        vReunion = Split(ColReunions(L), "|")(1)
        On Error Resume Next
        For Each O In IEdoc.Links
            vID = O.onclick
            If vID Like "*afficheDetailCourse(*" Then
                vID = Mid(vID, InStr(1, vID, "afficheDetailCourse(") + 20)
                vID = CStr(Val(vID)) & "|" & vReunion & "|" & O.innerText
                ColCourses.Add vID, vID
            End If
        Next O
    Next L
    'Quitter IE
    Set IEdoc = Nothing
    IE.Quit
    Set IE = Nothing
    Application.ScreenUpdating = True
    'Alimenter la liste ComboBox des éléments récoltés
    With Sheets("Accueil").ComboBox1
        .Clear
        .ColumnCount = 3
        .BoundValue = 3
        .Text = "< choisir une course >"
        For L = 1 To ColCourses.Count
            V = Split(ColCourses(L), "|")
            .AddItem V(0)
            .List(.ListCount - 1, 1) = V(1)
            .List(.ListCount - 1, 2) = V(2)
        Next L
    End With
    MsgBox "Liste mise à jour !  ", vbInformation + vbOKOnly, "myDearFriend!  -  www.mdf-xlpages.com"
End Sub

J'espère que ça correspondra bien à l'idée de ce que tu attendais...

Cela dit gmh, je me dois de t'informer que je ne vais pas pouvoir investir autant de temps à tes éventuelles prochaines demandes concernant ce même projet. Le forum XLpages est un forum d'apprentissage avant tout, l'objectif n'est en aucun cas de fournir des applicaitons "clé en main" (il y a d'autres endroits pour ça) et je pense que tu seras d'accord avec moi : on dérive peu à peu dans ce sens...
J'espère en tout cas t'avoir dépanner et même t'avoir donné envie d'apprendre VBA toi aussi .

Cordialement,

Pièce jointe:
zip mDF_PMU2.zip   [ Taille: 30.58 Ko - Téléchargements: 575 ]
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: Lister ID.
#3
gmh
Aspirant XLPages

Inscription: 20/05/2010

Messages: 21

Système d'exploitation:
PC
Version Excel utilisée:
2003,2007
Posté le : 27-05-2010 06h38
Bonjour,
Tout à fait d'accord.
Mais je n'ai pas toutes les bases nécessaire en VBA pour développer de tel projet qui me vienne en fonction de l'avancement de celui ci.
Mais je faisais aussi référence à notre précédent message, là, ou vous disiez qu'il faut indiquer le non de l'ID hors l'ID en question était quand même nombreux pour une course et les reprendre manuellement !!!!!

Je test le fichier mais cela semble correspondre à ma recherche.

j'ai aussi fait référence à d'autres sites, mais bravo pour le votre, votre rapidité qui parvient au mieux à répondre à mes attentes.

Cordialement
gmh
Hors Ligne
 Rapport   Haut 

Re: Lister ID.
#4
lemessager38
Débutant XLPages

Inscription: 15/11/2010

Messages: 10

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 17-11-2010 02h56
Bonsoir a tous et tout d abord bravo pour ce fabuleux fichier qui me rend tant service.

Par contre j aurai besoin de votre aide car je n arrive pas a faire une opération en Vba.

j aurais besoin de recuperer la musique de chaque cheval dans des cellules separes dans calculvaleur.

exemple pour le cheval 1 la musique est:

0m Da Da 4m 4m Dm (09) 4m 3m D... 

J' aurais besoin uniquement des 6 premieres courses.
(chiffres ou  premiere lettre dans chaque cellue (on efface egalement (09) )

soit pour le premier cheval:

0 D D 4 4 D 

un second exemple serait peut etre plus parlant :

pour le cheval 2 la Musique est :

5m 1m 7a 3a 5a 1a 8a 0a Da 0a 

j aurais besoin de 

5 1 7 3 5 1 

et ceci pour les 20 partants

sachant que la premiere valeur commence en G2 dans calcul valeur et la derniere en L2 pour le 1er cheval

j espere que j ai pu me faire comprendre car c est pas evident a expliquer tout ça .
en tout cas je vous remercie d'avance .

cordialement Christophe

pS :ci joint mon fichier excel





Pièce jointe:
zip PMu recup-valeur.zip   [ Taille: 62.24 Ko - Téléchargements: 615 ]
Hors Ligne
 Rapport   Haut 

Re: Lister ID.
#5
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 : 18-11-2010 01h10
Bonsoir lemessager38, bienvenue sur XLpages.com

Je te propose d'échanger ta procédure Macro1, par celle-ci (reliée à ton bouton) dans le module de code standard Module1 :
Option Explicit
' Auteur    : Didier FOURGEOT (myDearFriend!)  -  www.mdf-xlpages.com

Sub RecupValeurs()
Dim FSource As Worksheet, FCible As Worksheet
Dim LigneSourceEnCours As Long, LigneCibleEnCours As Long
Dim V As Variant, TabTemp As Variant
Dim Col As Byte

    Set FSource = Sheets("Partants")
    Set FCible = Sheets("CalculValeur")
    LigneSourceEnCours = 16
    LigneCibleEnCours = 2
    FCible.Range("B2:L21").ClearContents
    Do
   
        V = FSource.Cells(LigneSourceEnCours, 2).Value
        FCible.Cells(LigneCibleEnCours, 2) = IIf(Val(V) > 0, V, 0)
        V = FSource.Cells(LigneSourceEnCours + 1, 2).Value
        FCible.Cells(LigneCibleEnCours, 3) = IIf(Val(V) > 0, V, 0)
        V = FSource.Cells(LigneSourceEnCours + 2, 2).Value
        FCible.Cells(LigneCibleEnCours, 4) = IIf(Val(V) > 0, V, 0)
       
        V = FSource.Cells(LigneSourceEnCours + 7, 2).Value
        If Val(V) > 0 Then FCible.Cells(LigneCibleEnCours, 5) = V / 1000
        V = FSource.Cells(LigneSourceEnCours + 4, 2).Value
        If Val(V) > 0 Then FCible.Cells(LigneCibleEnCours, 6) = V / 1000

        'Musique !
        V = Replace(FSource.Cells(LigneSourceEnCours + 3, 2).Text, "(09) ", "")
        TabTemp = Split(V, " ")
        For Col = 0 To Application.Min(UBound(TabTemp) - 1, 5)  'les 6 premières courses seulement
            With FCible.Cells(LigneCibleEnCours, Col + 7)
                .Value = Left(TabTemp(Col), 1)
                 .HorizontalAlignment = xlCenter
            End With
        Next Col
       
        'On passe au cheval suivant
        LigneSourceEnCours = LigneSourceEnCours + 23
        LigneCibleEnCours = LigneCibleEnCours + 1
       
    Loop Until FSource.Cells(LigneSourceEnCours, 2) = ""
End Sub
Evidemment, ce n'est pas très optimisé, mais ça me parait compréhensible et fonctionnel...

Tu trouveras en pièce jointe ton classeur modifié en conséquence pour test.

Cordialement,


Nb: cette question aurait mérité un autre sujet (avec un lien sur celui ci le cas échéant)... Merci d'y penser la prochaine fois.

Pièce jointe:
zip PourLemessager38.zip   [ Taille: 47.26 Ko - Téléchargements: 1410 ]
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 

merci merci
#6
lemessager38
Débutant XLPages

Inscription: 15/11/2010

Messages: 10

Système d'exploitation:
PC
Version Excel utilisée:
2010
Posté le : 18-11-2010 22h48
 Je n 'ai qu 'un mot a dire Merci beaucoup grace a toi je vais gagner enomrmément de temps  avec ce fichier.

En ce qui concerne le sujet j ai hesiter a en creer un mais vu que la base etait deja un fichier existant du forum.

mais pour la prochaine fois pas de souci j' enferais un autre .
encore merci  !!!!!!

cordialement christophe
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