Saveas et remettre l'ancien fichier à l'écran

Version imprimable

Bonjour,
Dans une macro, je veux sauver un fichier avec des macros en un fichier sans macro avec un nouveau nom.
Puis remettre l'ancien fichier sur l'écran et fermer le nouveau fichier sauvé.
La commande saveas remplace le nouveau fichier mais une fois sauvé, je ne veux pas de ce fichier à l'écran.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
Sub MiseAZéro()
'
    Rep = MsgBox("Attention vous aller supprimer toutes les données de la feuille bilan.", vbYesNo + vbCritical, "ATTENTION")
    If Rep = vbNo Then GoTo fin
    ' On sauvegarde le fichier macros
    ActiveWorkbook.Save
    chemin = ActiveWorkbook.Path
    nom_fichier = ActiveWorkbook.Name
    an = Date
    an = Right(Str(an), 2)
    noms = "Sauvegarde année 20" & an
 
    With Sauve_annuelle
        .Répertoire = chemin
        .nom = noms
        .OKButton.SetFocus
        .Show
    End With
 
Rem ANNULE
If Sauve_annuelle.Tag = "ANNULER" Then
    StatusBar = "Abondon"
    GoTo fin
End If
    noms = Sauve_annuelle.nom
    nomsauve = chemin + "\" + noms
    '+ ".xlsx"
    Application.DisplayAlerts = False
    ActiveWorkbook.CheckCompatibility = False
 
'On sauvegarde au format sans macros
    ActiveWorkbook.SaveAs Filename:=nomsauve, FileFormat:=51, CreateBackup:=False
    Application.DisplayAlerts = True
 
'On est obligé d'ouvrir le fichier renommé    
    Application.Workbooks.Open nom_fichier
    nomsauve = chemin + "\" + noms + ".xlsx"
 
'Et là, je ne sais plus fermer mon fichier xlsx
 
 
' Workbooks(nomsauve).Worksheets("Données").Activate
'    Windows(nomsauve).Activate
'    Workbooks(nomsauve).Close
 
'Cette partie supprime une partie de mon fichier original
    Sheets("Bilan").Select
    Range("A2:J5000").Select
    Selection.ClearContents
    Selection.Clear
    Sheets("Données").Select
    ActiveWorkbook.Save
fin:
 
End Sub

Merci d'avance de votre aide.

20/03/2017, 19h16
Marc-L

Bonjour,

afin de ne pas modifier le fichier contenant le code, commencer par la méthode SaveCopyAs …

___________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
20/03/2017, 20h17
Superpat9999

Merci Marc, c'est bien cela, mais je ne peux pas ré-ouvrir le fichier renommé, je lui ai changé l'extension de fichier macro en xlsx. :(
21/03/2017, 15h05
Marc-L

Normal car comme c'est une copie, il faut évidemment ne pas changer l'extension !

Une fois la copie créée, l'ouvrir puis SaveAs au format désiré puis fermer et supprimer la copie via Kill, salut Bill !

_________________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

Merci beaucoup Marc, c'est parfait.
Je passe en résolu

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 
    Rep = MsgBox("Attention vous aller supprimer toutes les données de la feuille bilan.", vbYesNo + vbCritical, "ATTENTION")
    If Rep = vbNo Then GoTo fin
    ActiveWorkbook.Save
    chemin = ActiveWorkbook.Path
    nom_fichier = ActiveWorkbook.Name
    an = Date
    an = Right(Str(an), 2)
    noms = "Sauvegarde année 20" & an
 
    With Sauve_annuelle
        .Répertoire = chemin
        .nom = noms
        .OKButton.SetFocus
        .Show
    End With
 
Rem ANNULE
If Sauve_annuelle.Tag = "ANNULER" Then
    StatusBar = "Abondon"
    GoTo fin
End If
    noms = Sauve_annuelle.nom
    nomsauve = chemin + "\" + noms + ".xlsm"
 
'On sauvegarde au format avec macros
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs Filename:=nomsauve
 
 
'Une fois la copie créée, l'ouvrir puis SaveAs au format désiré puis fermer et supprimer la copie via Kill
    Application.Workbooks.Open nomsauve
    nomsauve = chemin + "\" + noms + ".xlsm"
    ActiveWorkbook.SaveAs Filename:=noms, FileFormat:=51, CreateBackup:=False
 
'Supprimer l'onglet feuille données et supprimer les boutons
    Worksheets("Données").Delete
    ActiveSheet.Buttons.Delete
 
'Sauvegarde et fermeture
    Workbooks(noms + ".xlsx").Close savechanges:=True
    Kill nomsauve
    Application.DisplayAlerts = True
 
'On modifie la feuille de travail.
    Sheets("Bilan").Select
    Range("A2:J5000").Select
    Selection.ClearContents
    Selection.Clear
    Sheets("Données").Select
    ActiveWorkbook.Save
fin:
End Sub

22/03/2017, 12h02
Marc-L

Remarques :

• Comme ton étiquette Fin en ligne n°52 se trouve juste avant End Sub,
remplacer les Goto Fin des lignes n°3 & 21 par Exit Sub, la ligne 52 devenant inutile …

• La ligne n°33 ne sert à rien car en doublon de la ligne n°24 !

• La ligne n°34 sauvegarde le classeur au nouveau format mais ensuite ses données sont modifiées
avant une nouvelle sauvegarde lors de sa fermeture en ligne n°41 : autant ne sauvegarder qu'une fois
en déplaçant cette ligne 34 juste avant la ligne 41 …

• La ligne n°48 est inutile vu la ligne n°49 !

• Les lignes n°46 à 49 peuvent - doivent ! - être réduite en une seule ligne de code car
un bon code n'a pas besoin de ces affreux ralentisseurs Select & Activate pour accéder aux cellules
en respectant juste le modèle objet d'Excel à savoir Classeur.Feuille.Plage.Méthode …

Citation:

Envoyé par Marc-L

Remarques :

• La ligne n°34 sauvegarde le classeur au nouveau format mais ensuite ses données sont modifiées
avant une nouvelle sauvegarde lors de sa fermeture en ligne n°41 : autant ne sauvegarder qu'une fois
en déplaçant cette ligne 34 juste avant la ligne 41 …

Merci Marc pour toutes ces sympathiques remarques :applo:
La ligne 34, est (à mon avis) bien placé car il faut pouvoir ouvrir le fichier .xlsm pour le modifier.
J'ai corrigé le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
    Rep = MsgBox("Attention vous aller supprimer toutes les données de la feuille bilan.", vbYesNo + vbCritical, "ATTENTION")
    If Rep = vbNo Then Exit Sub
    ActiveWorkbook.Save
    chemin = ActiveWorkbook.Path
    nom_fichier = ActiveWorkbook.Name
    an = Date
    an = Right(Str(an), 2)
    noms = "Sauvegarde année 20" & an
 
    With Sauve_annuelle
        .Répertoire = chemin
        .nom = noms
        .OKButton.SetFocus
        .Show
    End With
 
Rem ANNULE
If Sauve_annuelle.Tag = "ANNULER" Then
    StatusBar = "Abondon"
    Exit Sub
End If
    noms = Sauve_annuelle.nom
    nomsauve = chemin + "\" + noms + ".xlsm"
 
'On sauvegarde au format avec macros
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs Filename:=nomsauve
 
 
'Une fois la copie créée, l'ouvrir puis SaveAs au format désiré puis fermer et supprimer la copie via Kill
    Application.Workbooks.Open nomsauve
    ActiveWorkbook.SaveAs Filename:=noms, FileFormat:=51, CreateBackup:=False
 
'Supprimer l'onglet feuille données et supprimer les boutons
    Worksheets("Données").Delete
    ActiveSheet.Buttons.Delete
 
'Sauvegarde et fermeture
    Workbooks(noms + ".xlsx").Close savechanges:=True
    Kill nomsauve
    Application.DisplayAlerts = True
 
'On modifie la feuille de travail.
    ActiveWorkbook.Sheets("Bilan").Range("A2:J5000").Clear
    Sheets("Données").Select
    ActiveWorkbook.Save
End Sub

Bonne journée :)

23/03/2017, 11h43
Marc-L

• Une double sauvegarde est effectuée alors qu'une seule est nécessaire …

• Lignes n°7 à 9 : je ne vois pas d'utilité à convertir l'année de 4 chiffres en 2 chiffres
pour de suite la remettre sur 4 chiffres !
C'est comme si pour emprunter du sel à la voisine du palier on monte un étage à pied
pour le redescendre avec l'ascenseur !
Ces lignes pouvant être remplacées par noms = "Sauvegarde année " & Year(Date) …

• Ligne n°40 : lors d'une concaténation de texte préférer l'opérateur & au lieu du + …
23/03/2017, 12h04
Superpat9999
Citation:

Envoyé par Marc-L

• Une double sauvegarde est effectuée alors qu'une seule est nécessaire …

Je crois avoir compris ce que tu dis, mais je ne sais pas exécuter ces 2 lignes dans un classeur fermé
Code:

1 2 3 Worksheets("Données").Delete ActiveSheet.Buttons.Delete
23/03/2017, 12h06
Marc-L

Mais le classeur est déjà ouvert en ligne n°32 donc la ligne n°33 n'a lieu d'être qu'après les modifications et non avant !

Ce n'est pas grave pour un p'tit classeur mais pour un gros c'est à éviter …

Tu as entièrement raison :ave:
Encore une question, lors de la suppression de la plage
ActiveWorkbook.Sheets("Bilan").Range("A2:J5000").Clear
Je voudrais conserver la mise en forme des cellules, ou faut-il que je la refasse ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
    Rep = MsgBox("Attention vous aller supprimer toutes les données de la feuille bilan.", vbYesNo + vbCritical, "ATTENTION")
    If Rep = vbNo Then Exit Sub
    ActiveWorkbook.Save
    chemin = ActiveWorkbook.Path
    nom_fichier = ActiveWorkbook.Name
    noms = "Sauvegarde année " & Year(Date)
 
    With Sauve_annuelle
        .Répertoire = chemin
        .nom = noms
        .OKButton.SetFocus
        .Show
    End With
 
Rem ANNULE
If Sauve_annuelle.Tag = "ANNULER" Then
    StatusBar = "Abondon"
    Exit Sub
End If
    noms = Sauve_annuelle.nom
    nomsauve = chemin & "\" & noms & ".xlsm"
 
'On sauvegarde au format avec macros
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs Filename:=nomsauve
 
 
'Une fois la copie créée, l'ouvrir puis SaveAs au format désiré puis fermer et supprimer la copie via Kill
    Application.Workbooks.Open nomsauve
 
'Supprimer l'onglet feuille données et supprimer les boutons
    Worksheets("Données").Delete
    ActiveSheet.Buttons.Delete
    ActiveWorkbook.SaveAs Filename:=noms, FileFormat:=51, CreateBackup:=False
 
'Sauvegarde et fermeture
    Workbooks(noms & ".xlsx").Close savechanges:=True
    Kill nomsauve
    Application.DisplayAlerts = True
 
'On modifie la feuille de travail.
    ActiveWorkbook.Sheets("Bilan").Range("A2:J5000").Clear
    Sheets("Données").Select
    ActiveWorkbook.Save
End Sub

• Tu avais déjà la réponse dans ton code initial : utiliser la méthode ClearContents à la place de Clear …

• Ligne n°38 : ActiveWorkbook.Close …

• Sinon réécriture des lignes n°30 à 38 :
Code:

1 2 3 4 5 6 With Workbooks.Open(nomsauve) .Worksheets("Données").Delete .ActiveSheet.Buttons.Delete .SaveAs Filename:=noms, FileFormat:=51, CreateBackup:=False .Close End Sub

Merci Marc pour le temps passé à corriger mon code,
Je mets le code corrigé ci-dessous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
    Rep = MsgBox("Attention vous aller supprimer toutes les données de la feuille bilan.", vbYesNo + vbCritical, "ATTENTION")
    If Rep = vbNo Then Exit Sub
    ActiveWorkbook.Save
    chemin = ActiveWorkbook.Path
    nom_fichier = ActiveWorkbook.Name
    noms = "Sauvegarde année " & Year(Date)
 
    With Sauve_annuelle
        .Répertoire = chemin
        .nom = noms
        .OKButton.SetFocus
        .Show
    End With
 
Rem ANNULE
If Sauve_annuelle.Tag = "ANNULER" Then
    StatusBar = "Abondon"
    Exit Sub
End If
    noms = Sauve_annuelle.nom
    nomsauve = chemin & "\" & noms & ".xlsm"
 
'On sauvegarde au format avec macros
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs Filename:=nomsauve
 
'Une fois la copie créée, l'ouvrir puis SaveAs au format désiré puis fermer et supprimer la copie via Kill
    Application.Workbooks.Open nomsauve
 
'Supprimer l'onglet feuille données et supprimer les boutons, sauvegarde et fermeture
    With Workbooks.Open(nomsauve)
        .Worksheets("Données").Delete
        .ActiveSheet.Buttons.Delete
        .SaveAs Filename:=noms, FileFormat:=51, CreateBackup:=False
        .Close
    End With
    Kill nomsauve
    Application.DisplayAlerts = True
 
'On modifie la feuille de travail.
    ActiveWorkbook.Sheets("Bilan").Range("A2:J5000").ClearContents
    Sheets("Données").Select
    ActiveWorkbook.Save
End Sub

A bientôt
:merci: