Sujet Précédent Sujet Suivant

Correction bug dans mon code

stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012 - 24 juil. 2012 à 19:44
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012 - 29 juil. 2012 à 17:01
Bonjour à toutes et à tous,
Voilà j'ai un fichier excel dont j'ai une erreur 1004 qui se produit quand une certaine page n'a pas été trouvée et donc arrête l'importation des pages demandées. Je voudrais corriger ça en rajoutant un bout de code pour qu'il retente le téléchargement de cette page sans tout planter.
J'explique le fonctionnement de mon fichier j'ai dans un premier temps une feuille Accueil ou j'ai une cellule en D11 pour entrer une date (sauf date d'aujourd'hui)car il importe des résultats PMU donc toujours entrer une date autre que celle du jour sinon cela ne fonctionne pas. Ensuite j'ai deux boutons sur cette même feuille le premier pour importer tous les résultats de chaque réunion du jour demandé et le 2ème pour importer les courses choisi en colonne H de la feuille "Import" qui se créer automatiquement.
Voici le nom du premier module nommé "Import" 


Option Explicit
Public LaDate As String
Public Ws As Worksheet
'Public Pas As Double
Public NbTablo As Integer


Sub ImportPagePrincipale()
Dim I As Integer

  If IsDate(Range("D11")) Then
    Application.ScreenUpdating = False
    LaDate = Format(Range("D11"), "dd/mm/yyyy")
    
    Application.DisplayAlerts = False
    For I = Sheets.Count To 2 Step -1
      Sheets(I).Delete
    Next I
    Application.DisplayAlerts = True
    
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Import"
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "ImportReunions"
    
    Set Ws = Sheets("Import")
    
    ImportPage Ws.Name, "http://www.paris-turf.com/pid1-paris-turf-la-base-numero-1-du-turf.-tierce-quarte-quinte-pmu-pmh.html?date=" & LaDate
    Nettoyage
    Ws.Select
    
  End If
End Sub

Sub ImportTableaux()
Dim I As Integer

  Application.ScreenUpdating = False
  LaDate = Format(Range("D11"), "dd/mm/yyyy")
  UserForm1.Show 0
  Set Ws = Sheets("Import")

  NbTablo = Application.CountIf(Ws.Columns("H"), "x")
  If NbTablo > 0 Then
    LesReunions
    For I = 4 To Sheets.Count
      With Sheets(I).Cells
        .WrapText = False
        .EntireColumn.AutoFit
      End With
    Next I
    UserForm1.Height = 165
  End If
  Application.DisplayAlerts = False
  Sheets("Import").Delete
  Sheets("ImportReunions").Delete
  Application.DisplayAlerts = True
    
End Sub

Sub ImportPage(Feuille As String, Lien As String)
  
  UserForm1.Caption = Lien
  UserForm1.Repaint

  Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8"
  Sheets(Feuille).Cells.Clear
  
  With Sheets(Feuille).QueryTables.Add(Connection:= _
              "URL;" & Lien, Destination:=Sheets(Feuille).Range("A1"))
    .Name = "2012"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingAll
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
  End With
End Sub



dans ce premier module le 1er bouton est affecté a la macro "ImportPagePrincipale" et le 2ème boutons affecté a la macro "ImportTableaux"

Ensuite j'ai un 2ème module nommé "Nettoie" 

Option Explicit

Sub Nettoyage()
Dim Cel As Range
Dim Depart As String
Dim LgDep As Long
Dim LgFin As Long
Dim Lgder As Long
Dim Ligne As Long

  Application.ScreenUpdating = False
  
  With Ws
    ' On supprime les lignes jusqu'à la 1ère occurence de la date
    Ligne = 1
    Do While InStr(1, .Range("A" & Ligne), LaDate) = 0
      .Rows(Ligne).Delete
    Loop
    
    Lgder = .Range("A" & Rows.Count).End(xlUp).Row
    
    ' On cherche la ligne qui est juste après le dernier tableau
    ' Et on efface de cette ligne jusqu'à la fin de la page
    Set Cel = .Columns("A").Find(what:="La base numéro 1 du Turf", LookIn:=xlValues, lookat:=xlWhole)
    If Not Cel Is Nothing Then
      .Rows(Cel.Row & ":" & Lgder).ClearContents
    Else
      MsgBox "Impossible de trouver le marqueur : La base numéro 1 du Turf"
      End
    End If
    
    ' Entre chaque titre des réunions et le tableau on efface les lignes
    Set Cel = .Columns("A").Find(what:=LaDate, LookIn:=xlValues, lookat:=xlPart)
    If Not Cel Is Nothing Then
      Depart = Cel.Address
      Do
        .Rows(Cel.Row + 1 & ":" & Cel.Row + 9).ClearContents
        Set Cel = .Columns("A").FindNext(Cel)
      Loop While Not Cel Is Nothing And Depart <> Cel.Address
    End If
    
    ' On efface toutes les lignes avec "fermer"
    Set Cel = .Columns("A").Find(what:="fermer", LookIn:=xlValues, lookat:=xlWhole)
    If Not Cel Is Nothing Then
      Depart = Cel.Address
      Do
        .Rows(Cel.Row).ClearContents
        Set Cel = .Columns("A").FindNext(Cel)
      Loop While Not Cel Is Nothing
    End If
    
    ' On supprime toutes les lignes vierges
    On Error Resume Next
    .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    Lgder = .Range("A" & Rows.Count).End(xlUp).Row
  End With

End Sub



Et un 3ème module nommé "Reunions" 

Option Explicit

Sub LesReunions()
Dim Feuille As String
Dim J As Long
Dim Lgder As Long
Dim WsImp As Worksheet
Dim Cel As Range
Dim Progression As Double
Dim Pas As Double

  Set WsImp = Sheets("ImportReunions")
  
  Lgder = Ws.Range("A" & Rows.Count).End(xlUp).Row
  Pas = (UserForm1.Label5.Width - 4) / NbTablo
  
  For J = 1 To Lgder
    'If J = 10 Then Exit Sub
    If InStr(1, Ws.Range("A" & J), LaDate) > 0 Then
      Feuille = Left(Ws.Range("A" & J), InStr(1, Ws.Range("A" & J), " -") - 1)
    Else
      If Ws.Range("B" & J).Hyperlinks.Count 1 And Ws.Range("H" & J) "X" Then
        Progression = Progression + Round((100 / NbTablo), 2)
        UserForm1.Label2.Caption = Val(UserForm1.Label2.Caption) + 1
        UserForm1.Label3.Caption = Progression & "%"
        UserForm1.Label4.Width = Val(UserForm1.Label2.Caption) * Pas
        UserForm1.Caption = Ws.Range("B" & J).Hyperlinks(1).Address
        UserForm1.Repaint
        
        ImportPage "ImportReunions", Ws.Range("B" & J).Hyperlinks(1).Address
        'Stop
        With WsImp
          Set Cel = .Columns("A").Find(what:="Origines", LookIn:=xlValues, lookat:=xlWhole)
          If Not Cel Is Nothing Then
            .Rows(Cel.Row & ":" & Rows.Count).Delete
          Else
            MsgBox "Impossible de trouver le marqueur : Origines"
            End
          End If
          
          Set Cel = .Columns("A").Find(what:="1er", LookIn:=xlValues, lookat:=xlWhole)
          If Not Cel Is Nothing Then
            .Rows("1:" & Cel.Row - 2).Delete
          Else
            MsgBox "Impossible de trouver le marqueur : 1er"
            End
          End If
          
          On Error Resume Next
          .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
          On Error GoTo 0
          
          Lgder = .Range("A" & Rows.Count).End(xlUp).Row
          
          If FeuilleExiste(Feuille) = False Then
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = Feuille
          End If
          
          With .Range("A1:N" & Lgder)
            .Borders.Weight = xlThin
            .Copy Destination:=Sheets(Feuille).Range("A" & Rows.Count).End(xlUp).Offset(2, 0)
          End With
        End With
      End If
    End If
    
  Next J
  
End Sub


Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function



J'ai aussi ajouter un user form avec 5 label qui sert en faite de progresse barre et affiche le % de téléchargement + le nombre de courses importées. Il n'y a pas de code dedans juste la commande unload pour le bouton et fermer cette fenêtre.

Voilà j'aimerais vôtre aide surtout pour améliorer le code au niveau d'un echec de téléchargement d'une page.


Je précise aussi que l'erreur se produit en erreur 1004 avec le message impossible d'importer la page demandée en insistant cela fonctionne mais bon pas tout le temps et l'erreur arrive dans le module "Import" à la ligne

J'oubliais aussi au premier clik du 1er bouton deux feuilles se créer "Import" et "ImportReunions" dans la feuille "Import" il faut double cliquer dans la colonne H pour sélectionner les courses que l'on souhaite.

30 réponses

  • 1
  • 2
Réponse 1 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
25 juil. 2012 à 21:33
Pourrais-tu expliquer où survient cette erreur ?

Si la feuille n'a pas eu le temps d'être créée, mais le sera éventuellement sous peu, tu pourrais toujours mettre une boucle ou un "Timer" pour attendre sa création. Je ne comprends pas vraiment le fonctionnement de ton programme...

Autrement, tu peux aussi passer outre en gérant l'erreur.


MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 2 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
25 juil. 2012 à 22:19
Bonsoir,
L'erreur se produit quand le téléchargement des pages a commencés il peut importer 10 courses sans planter et parfois dès la première en faite comme si il ne trouvais pas la page comme un mauvais chargement de page internet.
0
Réponse 3 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
25 juil. 2012 à 23:06
J'utilise un peu la même méthode pour importer des tables d'un site Internet, et ça fonctionne bien tant que les pages ne changent pas. Quelquefois, ils modifient l'ordre des tables et ça ne fonctionne plus jusqu'à ce que je change mon code...

Par contre, je n'utilise pas ceci
Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8"
À quoi sert ce bout de code ?

Et où exactement, tu reçois cette erreur ? Sur quelle ligne ?


MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 4 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
25 juil. 2012 à 23:24
Le bout de code sert a vider le cache de IE pour le dossier temps ça évite qu'il soit trop remplis .
Et l'erreur je la reçois sur le module Import ici 
.Refresh BackgroundQuery:=False
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
25 juil. 2012 à 23:55
Dans le module import j'ai aussi fais une modif au lieu de mettre la date sous cette forme dd/mm/yyyy au deux endroit je l'ai mis ainsi yyyy/mm/dd.
0
Réponse 6 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
26 juil. 2012 à 03:04
Je pense qu'avant d'appeler Nettoyage tu devrais donner le focus à la feuille Import
Sheets("Import").Activate

Puis dans Nettoyage, il faut que tu mettes une sortie à ta boucle While
Do While InStr(1, .Range("A" & Ligne), LaDate) = 0
.Rows(Ligne).Delete
Loop
Avec ça, tu vas tourner en rond... Rien ne dit à la boucle d'arrêter...

C'est du moins ce que j'ai pu voir...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 7 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
26 juil. 2012 à 04:21
Merci MPI par contre si tu peux me dire ou je dois mettre tous ça !!! On m'a bcp aidé pour faire ce code celui qui me l'a fais m'a dis qu'on pouvais surement l'améliorer le seul truc qui est long c'est le chargement des pages j'aimerais bien le booster un peu mais bon dans un rêve MDRRR. Par contre ça ne change pas pour l'échec d'un chargement de page ou alors c'est IE qui est surement pas le mieux d’ailleurs je sais pas s'il peut utiliser un autre navigateur pour faire ces importation vu que c'est microsoft!!!
0
Réponse 8 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
26 juil. 2012 à 11:47
Si j'essaie de me connecter directement sur le site en question, à partir d'Excel, en utilisant la date du 24 disons, ça me donne des erreurs de scripts...
URL: http://www.paris-turf.com/pid1-paris-turf-la-base-numero-1-du-turf.-tierce-quarte-quinte-pmu-pmh.html?date=24/07/2012

Alors, c'est possible que le site ne soit pas écrit dans un langage 100% compatible avec l'engin d'Excel...(?)

Quelle est la partie que tu veux retracer sur cette page ?

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 9 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
26 juil. 2012 à 13:36
Bonjour,

L'adresse du site serais plus sur ce format là
http://www.paris-turf.com/pid1-paris-turf-la-base-numero-1-du-turf.-tierce-quarte-quinte-pmu-pmh.html?date=2012-07-24

C'est pour ça que j'ai changé le format de la date en yyyy/mm/dd dans le code car sur certaine page ça me provoquais un mauvais chargement pas complet.

Et ensuite je garde en faite que les tableaux avec leur prix et arrivées et le nom de la ville qui sert a créer le nom des feuilles. Certaine réunion sont en double donc le prend R1 R2 et R3 parfois R4 si c'est une nocturne et ensuite je passe a toute les courses PMH en bas.
0
Réponse 10 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
26 juil. 2012 à 13:42
Chez moi aussi j'ai l'erreur de script par deux fois alors je met non et ça m'ouvre aussi une page IE. C'est peu être être ça aussi qui ralenti le chargement et provoque les erreurs.
0
Réponse 11 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
27 juil. 2012 à 12:05
J'essaie de recréer le problème, mais ça devient compliqué puisque mon format de date est différent du tien (Québec)...

Par contre, si je comprends bien, la page ne s'importe pas toujours lorsque tu appelles cette ligne
ImportPage Ws.Name, "http://www.paris-turf.com/pid1-paris-turf-la-base-numero-1-du-turf.-tierce-quarte-quinte-pmu-pmh.html?date=" & LaDate

Tu pourrais alors vérifier si la feuille Import est vide avant d'appeler ta procédure Nettoyage.
Si la page est vide tu refais l'appel de ImportPage..., disons 5 ou 10 fois et, si ça ne fonctionne toujours pas, tu quittes.

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 12 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
27 juil. 2012 à 15:55
NON c'est pas cette page qui ne charge pas celle là ça va encore c'est quand je fais les importations tableaux elles sont importées dans la feuille importTableaux temporairement puis nettoyés puis sont copiés dans leur feuille respective au nom de la ville.
Mais l'idée est bonne elle reste la même mais pour la feuille ImportTableaux. Par contre si tu sais modifier le code avec toutes les modifs que tu m'a dis tu pourrais le coller ici.
0
Réponse 13 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2012 à 00:44
Chez moi, ceci
Format(Range("D11"), "dd/mm/yyyy")
donne 2012-07-24 (tel quel)

Alors je préfère mettre la date en D11 en format texte, c'est-à-dire précédée d'une apostrophe: '2012/07/24

Et l'importation et le nettoyage se font bien

Par la suite, je ne vois pas comment tu te retrouves avec des "X" en colonne H
Y a-t-il des formules ?


MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 14 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
28 juil. 2012 à 05:05
Les X en colonne H c'est pour sélectionner les courses qu'on veux si on double Click dessus ça les enlèvent car dans une réunion il y a entre 7 et 10 courses et le dimanche peu y avoir plus de 10 réunions ça fais pas loin de plus de 100 courses et toutes ne m’intéresse pas
0
Réponse 15 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
28 juil. 2012 à 06:17
Et la formule pour les X elle est dans le code du module reunions
0
Réponse 16 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2012 à 13:33
Tout ce que je vois dans le module Réunion, c'est une vérification comme ceci
If InStr(1, Ws.Range("A" & J), LaDate) > 0 Then
Feuille = Left(Ws.Range("A" & J), InStr(1, Ws.Range("A" & J), " -") - 1)
Else
If Ws.Range("B" & J).Hyperlinks.Count 1 And Ws.Range("H" & J) "X" Then

Je ne peux donc pas faire cette vérification puisque je n'ai pas la formule...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 17 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
28 juil. 2012 à 15:27
Il n'y a pas de formule dans les cellules tout est dans les codes. J'avais oublié il y a un code aussi dans la feuille thisWorkbook il est pour les X 


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  If Sh.Name = "Import" Then
    If Target.Column 8 And Range("B" & Target.Row).Hyperlinks.Count 1 Then
      Cancel = True
      If UCase(Target) "X" Then Target "" Else Target = "X"
    End If
  End If
End Sub
0
Réponse 18 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
28 juil. 2012 à 15:35
Ce petit bout de code sert a ajouter les X en double cliquant mais on peu le faire sans en les ajoutant manuellement en majuscule dans la colonne H mais ça c'est juste un détail ça influence pas sur la mauvaise importation parfois que j'ai chez moi.
0
Réponse 19 / 30
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 juil. 2012 à 16:35
J'ai fini par comprendre le fonctionnement...
et j'ai fait des tests sur 6 villes , 3 courses chacune (=18 courses)
Et tout fonctionne bien. Aucune erreur et j'ai bien 6 onglets avec 3 courses chacun. Ça prend environ 2 minutes 30 à 3 minutes.

Seules choses que j'ai modifiées (à part ce qui concerne le UserForm)

Dans Nettoyage 
    ' On supprime les lignes jusqu'à la 1ère occurence de la date
    LgFin = .Cells(Rows.Count, "A").End(xlUp).Row
    For I = 1 To LgFin
        If InStr(1, .Range("A" & I), LaDate) > 0 Then
            .Rows(1 & ":" & I - 1).Delete  'Effacer tout d'un coup plutôt que ligne par ligne
            Exit For
        End If
    Next


Et j'ai remplacé les "END" dans LesReunions par Exit Sub


MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0
Réponse 20 / 30
stepaustral Messages postés 54 Date d'inscription dimanche 5 janvier 2003 Statut Membre Dernière intervention 29 juillet 2012
28 juil. 2012 à 16:53
Sinon tu mettrais ou et quoi comme code pour demander si la feuille ImportTableaux est vide de refaire au moins 1 ou 2 essai d'importation?
0

Discussions similaires

[D7] Impression code-barres sur une imprimante d'étiquettes
cs_nitrique -
cs_nitrique -

15 réponses
Algorithme de vérification RIB (24 chiffres / maroc)
aedc -
ucfoutu -

5 réponses
Générateur de codes de recharge
cs_kdidier -
ucfoutu -

6 réponses
Les flèches en ASCII
mage_des_enfers -
magic_Nono -

25 réponses
Code barre datamatrix
cs_yves29 -
Whismeril -

21 réponses
Rejoignez-nous