Discussion :

[sebdub00]

Bonjour,

J'ai besoin d'une macro pour faire une sauvegarde automatique d'une feuille d'un modèle .xlt en prenant le contenu d'une cellule comme nom de fichier.

Ayant dormi pendant mes cours de visual basic, je ne sais pas comment faire.

Y a t-il quelqu'un pour m'aider ?

Merci

[Didier Gonard]

Bonjour,
pour exemple :

Code :

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

1
2
3
4
5
6
7
8
9
Sub Fermtout()
Dim Nomfic As String
 
Nomfic = Range("B4")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Nomfic
Application.DisplayAlerts = True
 
End Sub

ici, on sauve en xls par défaut
vois dans l'aide vba à saveas pour les détails multiples concernant le format, protection etc...


cordialement,

Didier

[sebdub00]

En fait j'avais besoin d'effectuer une sauvegarde d'une seule feuille du classeur avec chemin relatif (car utilisation de diverses copies du classeur sur plusieurs postes) et génération automatique du nom de fichier selon les informations saisies par les utilisateurs dans une autre feuille.

Ci-dessous le code qui me satisfait :

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
Sub SauveAuto()
 
    Dim chemin As String
 
    Dim Nomfichier As String
 
    Dim DateDevis As String
 
    Dim Indice As String
 
    DateDevis = Format(Now(), "dd-mm-yy")
 
    chemin = ActiveWorkbook.Path
 
    Sheets("DevisClientPLCHetACIERS").Select
    Range("A1:J71").Select
    Range("J71").Activate
 
    Nomfichier = Sheets("DevisClientPLCHetACIERS").Range("I1")
    Indice = Sheets("DevisClientPLCHetACIERS").Range("I2")
    Selection.Copy
        Workbooks.Open Filename:=chemin & "\Classeur1"
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-36
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:=chemin & "\Devis\DevisPlancher_" & Nomfichier & "_" & Indice & "_" & DateDevis, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Range("H72").Select
    ActiveWindow.SmallScroll Down:=-63
    Sheets("Accueil").Select
End Sub