Discussion :

[fifi5622]

bonjour

je possède un fichier excel ( fichier extraction de donnée du web ) qui fonctionne très bien mais je souhaiterai le modifier pour qu'il puisse
extraire d'autres donne ( et autant essaye de le faire par moi meme plus que de demander un code tt cuit ou je comprendrai rien ! )

si besoin je peux fournir le fichier excel ( avec la macro )

le code fonctionne , je voudrais juste que l'un d'entre vous me l'explique en detail dans la mesure du possible le code un peu dans ce style


par exemple F04.Cells.ClearContents ' efface toutes les donnees de la pageF04

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
 Sub Carriere()
    Dim Cel As Range
    Dim Nom As String
    Dim C As Range, Plage As Range
 
    Application.ScreenUpdating = False
    F04.Cells.ClearContents ''  
 
    If NotLogin Then WebCheval = "2,3,4" Else WebCheval = "1,3"
    If NotLogin Then WebJockey = "2,4" Else WebJockey = "1"
 
 
 
    'Extraction Jockey
    Set C = Range("B9:U9").Find("jockey", LookIn:=xlValues)
    If C Is Nothing Then Set C = Range("B9:U9").Find("driver", LookIn:=xlValues)
    Set Plage = Range(Cells(10, C.Column), Cells(Cells(Rows.Count, C.Column).End(xlUp).Row, C.Column))
    For Each Cel In Plage
        With Cel
            If .Hyperlinks.Count <> 0 Then
                Nom = Split(Split(.Hyperlinks(1).Address, "/")(4), "_")(0)
                Application.StatusBar = "Extraction Jockey/Driver : " & Nom
                Call GetJockey(Nom, .Hyperlinks(1).Address)
            End If
        End With
    Next Cel
    Set Plage = Nothing
 
 
    Call DWQ
    ' dwq est pour le login du site ici  je n'en ais pas besoin
 
 
    F04.Cells.Columns.AutoFit
 
    Application.ScreenUpdating = True
 
End Sub
 
Sub GetJockey(Nom As String, Lien As String)
    Dim Cellule As Range
    Dim Lig As Long
    With F04
        Lig = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Cells(Lig + 2, 1) = Nom
        .Cells(Lig + 2, 1).Font.ColorIndex = 3
        .Cells(Lig + 2, 1).Font.Bold = True
        With .QueryTables.Add( _
             Connection:="URL;" & Lien, _
             Destination:=.Cells(Lig + 3, 1))
            .BackgroundQuery = False
            .RefreshStyle = xlOverwriteCells
            .WebSelectionType = xlSpecifiedTables
            .WebTables = WebJockey
            .TablesOnlyFromHTML = True
            .WebDisableDateRecognition = True
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
    End With
End Sub

[bboy-eazy]

bonjour
voici quelques détails. Voir du coté de l'aide Vba pour les fonction (selection + touche F1)

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
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Carriere()
    Dim Cel As Range 'définit la variable cel comme range
    Dim Nom As String ' définit Nom comme chaine de caractère
    Dim C As Range, Plage As Range 'variable C et Plage comme range
 
    Application.ScreenUpdating = False ' arrete la mise à jour écran pour gagner du temps
    F04.Cells.ClearContents ''  ' efface F04.Cells
 
    If NotLogin Then WebCheval = "2,3,4" Else WebCheval = "1,3" ' condition si NotLogin (NotLogin soit être définit ailleurs) et WebCheval... il faut trouver comment ca a été définit
    If NotLogin Then WebJockey = "2,4" Else WebJockey = "1" 'idem
 
 
 
    'Extraction Jockey
    Set C = Range("B9:U9").Find("jockey", LookIn:=xlValues) ' définit C = comme cellule où a été trouvé le mot jockey dans la plage B9:U9
    If C Is Nothing Then Set C = Range("B9:U9").Find("driver", LookIn:=xlValues) ' si C est rien alors on fait la même recherche mais pour le mot driver
    Set Plage = Range(Cells(10, C.Column), Cells(Cells(Rows.Count, C.Column).End(xlUp).Row, C.Column)) 'définit la variable Plage de colonne où C a été trouvé et ligne 10 et dernière ligne non vide colonne ou C a été trouvé    For Each Cel In Plage
        With Cel 'avec Cel
            If .Hyperlinks.Count <> 0 Then ' début de condition: Si Hyperlink.count est différent de 0 ..ca je laisse aux pro
                Nom = Split(Split(.Hyperlinks(1).Address, "/")(4), "_")(0) 'variable Nom = ca je laisse aux pro
                Application.StatusBar = "Extraction Jockey/Driver : " & Nom ' Regarder dans l'aide Vba application.statusbar ...ca je laisse aux pro
                Call GetJockey(Nom, .Hyperlinks(1).Address) ' appel la procédure GetJockey(nom,lien) voir plus bas ...ca je laisse aux pro
            End If ' fin de condition
        End With 'fin du with
    Next Cel 'prochaine cel de la boucle
    Set Plage = Nothing 'définit Plage = rien
 
 
    Call DWQ 'appelle la procédure DWQ
    ' dwq est pour le login du site ici  je n'en ais pas besoin
 
 
    F04.Cells.Columns.AutoFit 'voir dans aide excel autofit
 
    Application.ScreenUpdating = True 'réactive mise à jour écran
 
End Sub
 
Sub GetJockey(Nom As String, Lien As String) 'procédure GetJockey(nom comme chaine de caractère, lien comme chaine de caractère)
    Dim Cellule As Range 'Cellule comme range
    Dim Lig As Long 'Lif comme valeur numérique
    With F04 ' avec F04
        Lig = .Cells(.Rows.Count, "A").End(xlUp).Row 'définit Lig comme première ligne non vide de la colonne A (valeur numérique car Long)
        .Cells(Lig + 2, 1) = Nom ' on est avec F04 donc les .Cells veulent dire: F04.Cells(Lig+2,1) et le format c'est Cells(ligne,colonne) par exemple Cells(1,2) = cellule B1
        .Cells(Lig + 2, 1).Font.ColorIndex = 3 '(mise en page couleur de la cellule F04.cells(Lig définit plus haut +2,colonne A)
        .Cells(Lig + 2, 1).Font.Bold = True 'mise en page
        With .QueryTables.Add( _ 'Je laisse aux pros voir du coté aide vba excel Querytables
             Connection:="URL;" & Lien, _
             Destination:=.Cells(Lig + 3, 1))
            .BackgroundQuery = False
            .RefreshStyle = xlOverwriteCells
            .WebSelectionType = xlSpecifiedTables
            .WebTables = WebJockey
            .TablesOnlyFromHTML = True
            .WebDisableDateRecognition = True
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
    End With
End Sub