Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

une proc avec With ActiveSheet.QueryTables.Add

1 réponse
Avatar
Fredo P.
Bonjour
Dans une procédure exécutant une recherche sur le web, j'ai parfois un arrêt
à la ligne:
" .Refresh BackgroundQuery:=False" avec un message indiquant la difficulté
de trouver la page Web cherchée. La routine repart manuellement après un
court moment d'attente.
Je ne souhaite pas employer "On Error resume next"
Je pense avoir besoin d'un bout de code genre: '
Do Until IE.ReadyState = 4
DoEvents
Loop
sachant que celui ci ne peut être employé vu qu' IE n'est pas créé et que
"DoEvents" seul ne suffit pas.
Ci dessous toute la proc:
For Each E In Gpc
Heure = cherch_heure_crs(E.Value) ' à revoir la fonction si utile
pour la suite (le 28/04/12)
If Not [IDCours!A:A].Find("arrivee.html?race_id=" & E) Is Nothing
Then
Adweb =
"URL;http://www.tierce-magazine.com/accueil/les-courses-apc/pid126-arrivee.html?race_id="
& E
Else
Adweb =
"URL;http://www.tierce-magazine.com/accueil/les-courses-avc/pid111-partants.html?race_id="
& E
End If
With ActiveSheet.QueryTables.Add(Connection:= _
Adweb _
, Destination:=Range("A1"))
.Name = "pid111-partants.html?race_id=" & E
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
' Do Until IE.ReadyState = 4
DoEvents
' Loop
.Refresh BackgroundQuery:=False
End With
If Not [A:A].Find("Arrivée", lookat:=xlWhole) Is Nothing Then '
InStr(Adweb, "Arrivée") > 0
If Cells(Application.Match("Place", [A1:A2000], 0) + 1, 1) = ""
And Cells(Application.Match("Place", [A1:A2000], 0) + 1, 2) = "1er" Then
Cells(Application.Match("Place", [A1:A2000], 0) + 1,
1).Delete Shift:=xlShiftToLeft
End If
Arrivées
ElseIf Not [A:A].Find("Partants", lookat:=xlWhole) Is Nothing Then

Chargement
End If
Next

1 réponse

Avatar
Fredo P.
Bonjour

Le code d'erreur est 1004, j'ai usé de cette solution, la ligne "Resume" en
fin d'algo produit une erreur (20), donc boucle sans cesse> géré par un exit
sub.
Ce n'est pas trop chouette! mais pour l'instant ça fonctionne.


Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
___________________________________________________
Sub Crsesdulendemain()
On Error GoTo Gesterr
With ActiveSheet.QueryTables.Add(Connection:= _
Adweb
' ".............tralala"
.Refresh BackgroundQuery:úlse
End With
Gesterr:
If Err.Number > 0 Then
Select Case Err.Number
Case 1004
Sleep 5000
Case 20
Err.Clear
Exit Sub
End Select
Err.Clear
Resume
End If
End Sub
"Fredo P." a écrit dans le message de news:
jnipag$pg9$
Bonjour
Dans une procédure exécutant une recherche sur le web, j'ai parfois un
arrêt à la ligne:
" .Refresh BackgroundQuery:úlse" avec un message indiquant la difficulté
de trouver la page Web cherchée. La routine repart manuellement après un
court moment d'attente.