Macro qui bloque sur Close SaveChanges:=False

Le
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:º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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #4752021
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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



François
Le #4751951
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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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







François
Le #4751921
N.B. LE MdP du VBA est " bosquet "
...


"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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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











Daniel.C
Le #4751801
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"
N.B. LE MdP du VBA est " bosquet "
...


"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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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















MichDenis
Le #4751751
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"
N.B. LE MdP du VBA est " bosquet "
...


"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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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











François
Le #4751721
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" 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"
N.B. LE MdP du VBA est " bosquet "
...


"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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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
















Daniel.C
Le #4751641
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"
N.B. LE MdP du VBA est " bosquet "
...


"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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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















François
Le #4750361
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"
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"
N.B. LE MdP du VBA est " bosquet "
...


"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" %
Bonsoir.
Quel est le message d'erreur ?
Cordialement.
Daniel
"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 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



















Publicité
Poster une réponse
Anonyme