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

**Superpat9999** · 20/03/2017, 19h03

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**Marc-L** · 20/03/2017, 19h16

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

**Superpat9999** · 20/03/2017, 20h17

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.

**Marc-L** · 21/03/2017, 15h05

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

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**Superpat9999** · 21/03/2017, 17h14

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Marc-L** · 22/03/2017, 12h02

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 …

**Superpat9999** · 23/03/2017, 11h16

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Marc-L** · 23/03/2017, 11h43

• 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 + …

**Superpat9999** · 23/03/2017, 12h04

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
   Worksheets("Données").Delete
    ActiveSheet.Buttons.Delete

**Marc-L** · 23/03/2017, 12h06

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 …

**Superpat9999** · 23/03/2017, 12h16

Tu as entièrement raison

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Marc-L** · 23/03/2017, 14h59

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

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Superpat9999** · 24/03/2017, 10h39

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Saveas et remettre l'ancien fichier à l'écran [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager