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

macro qui tourne à l'infini sans pour autant bogger

7 réponses
Avatar
François
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de feuille
en y ajoutant ".list", et les transfert dans un fichier portant le même nom
de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & "\"
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:=False
End If
End Sub

7 réponses

Avatar
LSteph
Bonjour,

C'est sans doute parceque tu as mis

fichier= Dir$(chemin & "*.xls")
et
Do Until fichier = ""
qui ne sera jamais ="" puisqu'au moins = à chemin

Essaie plutôt quelque chose ainsi,
fichier= dir("*.xls")
mais en ajoutant
Chdir chemin

attention j'ai repris mais pas testé:

''''''''''''''''''
Sub archiver()

Dim base As String, chemin As String, feuille As String, _
fichier As String

Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier= dir("*.xls")
feuille = ActiveSheet.Name
repere = 0
Chdir chemin
Do While len(fichier)>0
If fichier = "Old " & base Then
repere = 1
Workbooks.Open ("Old " & base)
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:="Old " & base
Workbooks.Open (base)
Workbooks("Old " & base).Close False
End If
End Sub


'lSteph

Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de feuille
en y ajoutant ".list", et les transfert dans un fichier portant le même nom
de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub





Avatar
LSteph
...heu, pardon,le fichier =dir("*.xls")
;o) à mettre juste après le Chdir sinon cela ne sert à rien...!

'...
Chdir chemin
fichier= dir("*.xls")
Do While len(fichier)>0
'....

et puis le rappeler dans le do while ... avant le loop sinon on boucle
toujours le même

'...
fichier=dir
Loop
'...

Bonjour,

C'est sans doute parceque tu as mis

fichier= Dir$(chemin & "*.xls")
et
Do Until fichier = ""
qui ne sera jamais ="" puisqu'au moins = à chemin

Essaie plutôt quelque chose ainsi,
fichier= dir("*.xls")
mais en ajoutant
Chdir chemin

attention j'ai repris mais pas testé:

''''''''''''''''''
Sub archiver()

Dim base As String, chemin As String, feuille As String, _
fichier As String

Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier= dir("*.xls")
feuille = ActiveSheet.Name
repere = 0
Chdir chemin
Do While len(fichier)>0
If fichier = "Old " & base Then
repere = 1
Workbooks.Open ("Old " & base)
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:="Old " & base
Workbooks.Open (base)
Workbooks("Old " & base).Close False
End If
End Sub


'lSteph

Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi
que la feuille de décompte associée (octobre.list) reprenant le même
nom de feuille en y ajoutant ".list", et les transfert dans un fichier
portant le même nom de fichier mais précédé de "Old " (dans le même
dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier
As String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub







Avatar
François
Bonjour,

Il y a un problème dans ta boucle Do Until fichier = "" ... Loop.
En effet, si tu entres dans la boucle (variable fichier <> ""), tu ne
pourras plus en sortir, vu que tu ne modifies pas cette variable à
l'intérieur de la boucle.

Je pense que tu as oublié

fichier=Dir

juste avant le Loop.

A+

François


"François" a écrit dans le message de news:
%
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant le
même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub






Avatar
François
Merci beaucoup,

Vous avez résolu un problème que ma connaissance (très partielle) du vab de
Excel n'effleurait même pas.

Tout fonctionne bien maintenant.

Merci à Lsteph et François.

François

"François" a écrit dans le message de news:
%
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que la
feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant le
même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub





Avatar
jps
un vab?
on avait déjà les scuds....ça devient la guerre ici
jps

"François" a écrit dans le message de news:

Merci beaucoup,

Vous avez résolu un problème que ma connaissance (très partielle) du vab
de Excel n'effleurait même pas.

Tout fonctionne bien maintenant.

Merci à Lsteph et François.

François

"François" a écrit dans le message de news:
%
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que
la feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant
le même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub









Avatar
LSteph
;o)

un vab?
on avait déjà les scuds....ça devient la guerre ici
jps

"François" a écrit dans le message de news:

Merci beaucoup,

Vous avez résolu un problème que ma connaissance (très partielle) du vab
de Excel n'effleurait même pas.

Tout fonctionne bien maintenant.

Merci à Lsteph et François.

François

"François" a écrit dans le message de news:
%
Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que
la feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant
le même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub












Avatar
François
Merci à tous,

(et pardon pour le retard ...)

Cela fonctionne désormais parfaitement.

François

"LSteph" a écrit dans le message de news:

...heu, pardon,le fichier =dir("*.xls")
;o) à mettre juste après le Chdir sinon cela ne sert à rien...!

'...
Chdir chemin
fichier= dir("*.xls")
Do While len(fichier)>0
'....

et puis le rappeler dans le do while ... avant le loop sinon on boucle
toujours le même

'...
fichier=dir
Loop
'...

Bonjour,

C'est sans doute parceque tu as mis

fichier= Dir$(chemin & "*.xls")
et
Do Until fichier = ""
qui ne sera jamais ="" puisqu'au moins = à chemin

Essaie plutôt quelque chose ainsi,
fichier= dir("*.xls")
mais en ajoutant
Chdir chemin

attention j'ai repris mais pas testé:

''''''''''''''''''
Sub archiver()

Dim base As String, chemin As String, feuille As String, _
fichier As String

Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier= dir("*.xls")
feuille = ActiveSheet.Name
repere = 0
Chdir chemin
Do While len(fichier)>0
If fichier = "Old " & base Then
repere = 1
Workbooks.Open ("Old " & base)
Workbooks(base).Sheets(feuille & ".list").Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Move _
After:=Workbooks("Old " & base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list" Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:="Old " & base
Workbooks.Open (base)
Workbooks("Old " & base).Close False
End If
End Sub


'lSteph

Bonjour à tous,

J'ai un fichier (calendrier) qui contient une macro "d'archivage" qui
sélectionne la feuille active (le mois d'octobre par exemple) ainsi que
la feuille de décompte associée (octobre.list) reprenant le même nom de
feuille en y ajoutant ".list", et les transfert dans un fichier portant
le même nom de fichier mais précédé de "Old " (dans le même dossier).
Si ce dossier (Old ...) n'existe pas, il est alors créé.

Problème : cette macro tourne à l'infini sans pour autant bloquer !

Je ne comprends pas où est mon erreur !

Si l'un d'entre-vous a une piste ?...
(je peux mettre le fichier en Cjoint si nécessaire)

Merci à tous

François

Sub archiver()

Dim base As String, chemin As String, feuille As String, fichier As
String
Dim repere As Byte
chemin = ActiveWorkbook.Path & ""
base = ActiveWorkbook.Name
fichier = Dir$(chemin & "*.xls")
feuille = ActiveSheet.Name
repere = 0
Do Until fichier = ""
If fichier = "Old " & base Then
repere = 1
Workbooks.Open (chemin & "Old " & base)
Workbooks(base).Sheets(feuille & ".list").Select
Sheets(feuille & ".list").Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
Workbooks(base).Sheets(feuille).Select
Sheets(feuille).Move After:=Workbooks("Old " &
base).Sheets(Sheets.Count)
End If
Loop
If repere = 0 Then
Dim wsh As Worksheet
Application.DisplayAlerts = False
For Each wsh In ActiveWorkbook.Sheets
If wsh.Name <> feuille And wsh.Name <> feuille & ".list"
Then
Sheets(wsh.Name).Delete
End If
Application.DisplayAlerts = True
Next
ActiveWorkbook.SaveAs Filename:=chemin & "Old " & base
Workbooks.Open (chemin & base)
Workbooks(chemin & "Old " & base).Close SaveChanges:úlse
End If
End Sub