VBA:erreur d'exécution 6

[claude09]

Bonsoir,ci joint le code VBA qui pose probléme.Quand je lance,il me met:erreur d'exécution 6,dépassement de capacité.La ligne en question est coloriée en jaune.Merci.

 

[bérylion]

Re : VBA:erreur d'exécution 6

salut

c'est ça qui coince :

Dim i As Byte

essaie plutot avec

Dim i As integer

ou

Dim i As long

 

[claude09]

Re : VBA:erreur d'exécution 6

Merci.J'ai bien fait les modifications,mais çà coince encore au niveau de la ligne coloriée en jaune :l'indice n'appartient pas à la sélection.Ci joint le code modifié ;Merci.

 

[Pierrot93]

Re : VBA:erreur d'exécution 6

Bonjour,

pas ouvert ton fichier, pas 2007 à dispo, mais vu le type d'erreur, regarde bien les noms de feuille ou de classeur utilisés dans ton code, sans doute l'un d'entre eux n'est pas valide sur la ligne qui bogue...

bonne journée
@+

 

[JNP]

Re : VBA:erreur d'exécution 6

Bonjour le fil 🙂,

pas ouvert ton fichier, pas 2007 à dispo,

T'as rien perdu, il contient simplement un copier/coller du code en dur dans la feuille

Option Explicit
Sub Traitement()
Dim vURL As String
    'URL de départ (à adapter au besoin)
    vURL = "[url=http://www2.france-galop.com/fgweb/Domaines/Chevaux/cheval_perf.aspx?navigationChevaux=true&idcheval=03153823&aaCrse=2010&cSp=P&numCrsePgm=297&statut=DP]FG - Chevaux et acteurs : performances chevaux[/url]"
    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 Long
'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("[URL="http://www.mdf-xlpages.com"]www.mdf-xlpages.com[/URL]")
        '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!  -  [URL="http://www.mdf-xlpages.com"]www.mdf-xlpages.com[/URL]"
End Sub
Sub RecupCarriere(R As Range, Ncheval As String)
Dim vURL As String
    vURL = "[url=http://www2.france-galop.com/fgweb/Domaines/Chevaux/cheval_perf.aspx?navigationChevaux=true&idcheval]France-Galop : Erreur[/url]="
    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

avec juste la ligne

For i = 1 To UBound(TabChevaux, 2)

surlignée en jaune 🙄...
Si tu as quelques heures pour décortiquer le code et faire des tests, pas moi 😡...
Bonne journée 😎

 

[Pierrot93]

Re : VBA:erreur d'exécution 6

Re, bonjour JNP🙂

Si tu as quelques heures pour décortiquer le code et faire des tests, pas moi ...

non pas vraiment de temps non plus... petit conseil tout de même, vérifier comment la variable tableau est dimensionnée lors de l'erreur...