Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Macro qui bloque sur Close SaveChanges:=False

Macro qui bloque sur Close SaveChanges:=False

8 réponses
Avatar
François
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre fichier à
la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As String,
annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete ...",
"Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & "\"

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets, if
no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:=base, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:=False

End If

End Sub
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Daniel.C
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre fichier à
la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets,
if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub



Avatar
François
Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur ...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to old
file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre fichier
à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets,
if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub







Avatar
François
N.B. LE MdP du VBA est " bosquet "
...


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

Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur ...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to
old file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre fichier
à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close
SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets,
if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub











Avatar
Daniel.C
Il y a quelque chose d'anormal. Le classeur que tu veux fermer avec
sauvegarde contient une macro évènementielle "before save" qui ne peut se
déclencher, je ne sais pas trop pourquoi. En commentant la ligne :
application.enableevents=true
il n'y a pas de plantage.
Daniel
"François" a écrit dans le message de news:

N.B. LE MdP du VBA est " bosquet "
...


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

Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur ...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to
old file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre
fichier à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close
SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret
sheets, if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub















Avatar
MichDenis
Dans le haut de ton module "Archiver" (première ligne), copie ceci :

Option Compare Text ' afin d'éviter des surprises sur l'usager ne respecte pas la casse !

J'ai fait 2 tests consécutifs sans problème ! ce dernier n'était pas en mode "lecture seule"

En mode lecture seule, la procédure est instable...

Si tu veux ouvrir ton fichier en lecture seule, pourquoi ne pas utiliser cette ligne de commande
dans l'événement "Open" du ThisWorkbook

ThisWorkbook.ChangeFileAccess xlReadOnly, WritePassword:="rouen"

Dans ta procédure problématique, pour être capable de sauvegarder ton fichier
tel que propose en outre ta ligne de code Workbooks("Base"):.Save , tu pourras utiliser
ceci juste avant :
Workbooks("Base").ChangeFileAccess xlReadWrite, WritePassword:="rouen"

et terminer par :
ThisWorkbook.ChangeFileAccess xlReadOnly, WritePassword:="rouen"

Version Excel 2003




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

N.B. LE MdP du VBA est " bosquet "
...


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

Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur ...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to
old file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre fichier
à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close
SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret sheets,
if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub











Avatar
François
Bonjour,

Je vais mettre tout cela dans le fichier ce soir et te répondrait sur le
forum.
J'ai omis de préciser que j'avais la version Excel 2000 sous XP. Je ne sais
pas si cela a de l'importance pour ce code là.
Par ailleurs, la procédure d'archivage est censée n'être lancée que lorsque
le fichier a été ouvert avec le mot de passe - donc ce n'est pas un souci si
la procédure n'est pas stable en mode "lecture seule"... et il suffira
d'ajouter une demande de mot de passe pour éliminer cette possibilité.

Merci beaucoup pour ta réponse et à ce soir

François

"MichDenis" a écrit dans le message de news:
ua%
Dans le haut de ton module "Archiver" (première ligne), copie ceci :

Option Compare Text ' afin d'éviter des surprises sur l'usager ne
respecte pas la casse !

J'ai fait 2 tests consécutifs sans problème ! ce dernier n'était pas en
mode "lecture seule"

En mode lecture seule, la procédure est instable...

Si tu veux ouvrir ton fichier en lecture seule, pourquoi ne pas utiliser
cette ligne de commande
dans l'événement "Open" du ThisWorkbook

ThisWorkbook.ChangeFileAccess xlReadOnly, WritePassword:="rouen"

Dans ta procédure problématique, pour être capable de sauvegarder ton
fichier
tel que propose en outre ta ligne de code Workbooks("Base"):.Save , tu
pourras utiliser
ceci juste avant :
Workbooks("Base").ChangeFileAccess xlReadWrite, WritePassword:="rouen"

et terminer par :
ThisWorkbook.ChangeFileAccess xlReadOnly, WritePassword:="rouen"

Version Excel 2003




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

N.B. LE MdP du VBA est " bosquet "
...


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

Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur ...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to
old file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre
fichier
à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close
SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret
sheets,
if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub
















Avatar
Daniel.C
En fait, ton appli plante sur l'instruction :
If Not Intersect(Target, Range(Range("ChampMFC2"))) Is Nothing And
Target.Count = 1 And Not temoin Then
de la macro :
Worksheet_change de la feuille "Jan" du claseur Old 2008....
Tu plantes apparemment sur le close parce que le code du fichier Old 2008...
est protégé par mot de passe. Mets un point d'arrêt tout de suite après
l'insttruction Open et déverrouille le code.
Tu as un tas de noms comme "ChampMFC2" qui sont définis par "#REF!".
Cordialement.
Daniel

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

N.B. LE MdP du VBA est " bosquet "
...


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

Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur ...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to
old file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre
fichier à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon lecture
seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close
SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list" And
wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret
sheets, if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub















Avatar
François
Bonsoir Daniel C.

Je n'avais effectivement pas détecté d'où venait ce problème ...
Sans doute lors du transfert de feuille, la perte des noms de cellules !
Mais si j'arrive à concrétiser le programme pour supprimer toutes les lignes
de programmes lors du transfert, ce problème devrait être contourné ...

Merci beaucoup pur ton aide

François

"Daniel.C" a écrit dans le message de news:

En fait, ton appli plante sur l'instruction :
If Not Intersect(Target, Range(Range("ChampMFC2"))) Is Nothing And
Target.Count = 1 And Not temoin Then
de la macro :
Worksheet_change de la feuille "Jan" du claseur Old 2008....
Tu plantes apparemment sur le close parce que le code du fichier Old
2008... est protégé par mot de passe. Mets un point d'arrêt tout de suite
après l'insttruction Open et déverrouille le code.
Tu as un tas de noms comme "ChampMFC2" qui sont définis par "#REF!".
Cordialement.
Daniel

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

N.B. LE MdP du VBA est " bosquet "
...


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

Bonjour Daniel. C

c'est justement là le problème, je n'ai qu'un message vierge d'erreur
...
voilà le fichier en Cjoint - il suffit d'activer le bouton "Transfer to
old file" sur la feuille Jan puis Feb pour que le pb survienne ...

http://cjoint.com/?jjwuieVF8p

François


"Daniel.C" a écrit dans le message de news:
%
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"François" a écrit dans le message de news:
%
Bonjour,

Excel me bogue un programme de transfert de feuille sur un autre
fichier à la ligne :
"Workbooks("Old " & annee & " " & base).Close SaveChanges:=True"
, et l'aide proposée par le débogueur est une page blanche !...
Je ne comprends pas pourquoi ?
Le fichier est protégé à l'ouverture par un mot de passe (sinon
lecture seule) - est-ce que cela vient de là ?
Si nécessaire, je peux mettre le fichier en Cjoint

Merci pour votre aide

François

Ci dessous le programme qui pose problème

Sub archiver()



Dim base As String, chemin As String, feuille As String, fichier As
String, annee As String, n As Byte

Dim repere As Byte, wsh As Worksheet



Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.EnableEvents = False

feuille = ActiveSheet.Name

feuille = InputBox("Enter the name of the calendar sheet to delete
...", "Sheet to transfer to the old file", feuille)

chemin = ActiveWorkbook.Path & ""

base = ActiveWorkbook.Name

annee = Year([A2])

ChDir chemin

fichier = Dir("*.xls")

repere = 0

For n = 2 To 9

ActiveSheet.Cells(n, 28).Name.Delete

Next n

ChDir chemin

Do While Len(fichier) > 0

If fichier = "Old " & annee & " " & base Then

repere = 1

Workbooks.Open Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Workbooks(base).Sheets(feuille).Move _

After:=Workbooks("Old " & annee & " " &
base).Sheets(Sheets.Count)

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close
SaveChanges:=True

End If

fichier = Dir

Loop

If repere = 0 Then

Sheets("Memoire").Visible = True

For Each wsh In ActiveWorkbook.Sheets

If wsh.Name <> feuille And wsh.Name <> feuille & ".list"
And wsh.Name <> "Memoire" Then

Sheets(wsh.Name).Delete

End If

Next

Sheets("Memoire").Visible = xlVeryHidden ' we hide secret
sheets, if no longer Very hidden

ActiveWorkbook.SaveAs Filename:="Old " & annee & " " & base,
Password:="rouen"

Workbooks.Open Filename:ºse, Password:="rouen"

Workbooks(base).Sheets(feuille & ".list").Delete

Workbooks(base).Sheets(feuille).Delete

Workbooks(base).Save

Application.DisplayAlerts = True

Application.EnableEvents = True

Application.ScreenUpdating = True

Workbooks("Old " & annee & " " & base).Close SaveChanges:úlse

End If

End Sub