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
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