Boucle qui bloque ou Bug

[seb.m]

Bonjour,

Apres l'ouverture d'une discution qui m'a permit d'arrivé jusqu'a la grace a vous

J'ai souhaité essayer de comprendre mais la je bloque

la boucle fonctionne parfaitement sans le Call RecuperationKm

Je pense que le probleme vient de la fonction Dir qui se trouve presente dans les deux macro mais pas vers le meme repertoire

Quel solution puis je trouvée pour que ca fonctionne

Le Bug se trouve lorsque dans recuperationKm le fichier n'existe pas il doit passer ca route mais la macro bloque sur la ligne

Fich = dir ' de la macro boucle

Lorsque la macro se deroule sans fichier manquant elle ne boucle pas la fin de la premiere boucle elle s'arrete

voila le code tel qu'il est dans ma macro
__________________________________________________ __________
Sub Boucle()
CheminDestination = "\\b660917\_IPEDATA\80001077\XLS\"

Set listfich = Sheets(1).Range("a4")

fich = dir(CheminDestination & "*.xls")
While fich <> ""
If existe(fich) = False Then


Call OuvertureClasseur
Call RecuperationDonnee
Call RecuperationKM


Else
End If
fich = dir
Wend
Call TrierLesDonnee
Call MiseEnPage
End Sub

__________________________________________________ ________
Function existe(fich)
i = 0
While listfich.Offset(i, 0) <> ""
If listfich.Offset(i, 0) = fich Then existe = True
i = i + 1
Wend
End Function
__________________________________________________ __________________

Sub RecuperationKM()

ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = ClasseurName
ActiveCell.Replace What:="CO04", Replacement:="DO01"
ActiveCell.Replace What:=".xls", Replacement:=".csv"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Offset(0, -1).Range("A1").Select
ClasseurKmName = ActiveCell.Value
If dir("\\b660917\_IPEDATA\80001077\CSV\" & ClasseurKmName) <> "" Then
Workbooks.OpenText Filename:="\\b660917\_IPEDATA\80001077\CSV\" & ClasseurKmName, DataType:=1, Semicolon:=True, local:=True
Set wbkKm = ActiveWorkbook
Range("ax38").Select
Selection.End(xlDown).Select
ActiveCell.Copy
Windows("Extraction Donnée STT.xls").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
wbkKm.Close (False)
Else
MsgBox "Classeur absent..."
Exit Sub
End If

End Sub




Merci a ceux qui connaisse la solution

 

[seb.m]

Re : Boucle qui bloque ou Bug

Up

Persone n'a une idée o tout le monde est en congés

Bonnes vacances a ceux qui y sont