Enregistrer un même fichier avec l'année et un Nº d'indice : File-2017-N°1, File-2017-N°2 ,.., File-2018-N°1

**ghazalinadou** · 28/08/2017, 09h51

Bonjour
je génère régulièrement un fichier qui porte toujours le même nom (Préparation de travail N°:cc/2017/N°1.xls)
Pour que ne pas écraser le fichier généré précédement, je dois indicer le nom du fichier crée.
Le nom de ce fichier est donc complété avec un symbole N°x où x est un nombre qui s'incrémente de manière automatique avec aussi l'année 2017 , 2018. En un recherche sur internet j'ai trouvé cet article:
http://ericrenaud.fr/droitefichiers.htm#Top
mais Problème rencontréé est le suivant :
format est n'est pas juste :

Code :

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

1
2
 
ActiveWorkbook.SaveAs Filename:= _Chemin  &  "\"  &  NameSansExtension  &  "-v"  &  NoIndice  &  ".xls" , _

Ainsi:

Code :

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

1
2
3
4
5
6
7
8
9
 
 
Public  NameSansExtension  As String 
 
Public  ThisName  As String 
 
Public  Chemin  As String 
 
Public  NoIndice  As Integer

Je comprends pas cette déclaration.

Quelqu'un peut m'aider stp , merci

**kiki29** · 28/08/2017, 10h41

Salut, en t'inspirant de cette fonction et en l'adaptant à ton contexte

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
Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object
 
   Set FSO = CreateObject("Scripting.FileSystemObject" )
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)
 
        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000" ) & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing
 
   RenommerFichier = sDossier & "\" & sNomfichier
End Function

Un exemple, qui te permettra de voir l'usage de cette fonction.

**ghazalinadou** · 28/08/2017, 11h00

Vous l'enregistrer sous format PDF pour l'imprimer après ?? j'arrive pas a adapté votre code avec le miens

**kiki29** · 28/08/2017, 13h43

Gente Dame, pdf ou n'importe quel autre format enfin bref, en reprenant le code fourni par ton lien pour du xls. A toi de l'adapter à ton contexte.

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
Option Explicit
 
Sub Execution()
Dim chemin As String
Dim MyDate As String
Dim sNomfichier As String
 
    MyDate = Format(Now(), "dd-mm-yy")
    chemin = ActiveWorkbook.Path
 
    Workbooks.Add
    sNomfichier = RenommerFichier(chemin, "Synthèse carnet" & "-" & MyDate & ".xls")
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Je saisis mes données."
    ActiveWorkbook.SaveAs Filename:=sNomfichier, FileFormat:=xlNormal
    ActiveWorkbook.Close savechanges:=False
End Sub

**ghazalinadou** · 28/08/2017, 14h29

Ca fonctionne bien , merci. J'ai pensée a ajouter aussi un bouton pour mettre sous format pdf un peu comme vous avez fais dans votre article.

**ghazalinadou** · 28/08/2017, 14h49

en fait lorsque j'ai regardé mon fichier enregistrer , il est vide , j'ai qu'une feuille, et j'essayer de l'enregistrer sous format xlsb pour récupérer les macros avec mais i s'ouvre pas après
Nom : prepartion.JPG
Affichages : 532
Taille : 17,9 Ko

Nom : prepartion.JPG
Affichages : 532
Taille : 17,9 Ko

Nom : erreu.JPG
Affichages : 582
Taille : 44,5 Ko

**kiki29** · 28/08/2017, 15h34

Re, la partie qui change pour le format xlsb

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
Sub Execution()
Dim chemin As String
Dim MyDate As String
Dim sNomfichier As String
 
    MyDate = Format(Now(), "dd-mm-yy")
    chemin = ActiveWorkbook.Path
 
    Workbooks.Add
    sNomfichier = RenommerFichier(chemin, "Synthèse carnet" & "-" & MyDate & ".xlsb")
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Je saisis mes données."
    ActiveWorkbook.SaveAs Filename:=sNomfichier, FileFormat:=xlExcel12
    ActiveWorkbook.Close savechanges:=False
End Sub

**ghazalinadou** · 28/08/2017, 15h37

Oui mais le problème mon classeur est vide , il contient qu'une feuil 1 vide

**ghazalinadou** · 28/08/2017, 15h38

Je pars avec classeur de taille 2008 Ko , et je stocke que un classeur de taille 8ko

**kiki29** · 28/08/2017, 15h44

Re, l'exemple fourni fonctionne donc et ne donne que des fichiers vides ce qui est normal. A toi de copier ce qui t'intéresse après le Workbooks.Add dans la procédure, mais là n'étant pas devin.

**kiki29** · 28/08/2017, 15h54

Re, Cela demandera à ce que tu l'adaptes à ton contexte pour une feuille ou un classeur entier

Feuille :

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
Sub Execution()
Dim chemin As String
Dim MyDate As String
Dim sNomfichier As String
Dim Wkb As Workbook, WshDep As Worksheet
Dim Rng As Range
 
    MyDate = Format(Now(), "dd-mm-yy")
    chemin = ActiveWorkbook.Path
 
    Set Wkb = Workbooks.Add
    Set WshDep = ThisWorkbook.Worksheets(1)
    Set Rng = WshDep.UsedRange
 
    Rng.Copy Wkb.Worksheets(1).Range("A1")
 
    sNomfichier = RenommerFichier(chemin, "Synthèse carnet" & "-" & MyDate & ".xlsb")
 
    Wkb.SaveAs Filename:=sNomfichier, FileFormat:=xlExcel12
    Wkb.Close savechanges:=False
 
    Set Rng = Nothing
    Set WshDep = Nothing
    Set Wkb = Nothing
End Sub

Classeur :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Execution()
Dim chemin As String
Dim MyDate As String
Dim sNomfichier As String
 
    MyDate = Format(Now(), "dd-mm-yy")
    chemin = ActiveWorkbook.Path
 
    sNomfichier = RenommerFichier(chemin, "Synthèse carnet" & "-" & MyDate & ".xlsb")
 
    ActiveWorkbook.SaveAs Filename:=sNomfichier, FileFormat:=xlExcel12
    ActiveWorkbook.Close savechanges:=True
End Sub

**ghazalinadou** · 28/08/2017, 16h28

Merci ca fonctionne , ce n''est pas évident lorsqu'on ait débutant et en plus dernier semaine de stage me demande de faire ça pas de temps pour apprendre de 0

**kiki29** · 28/08/2017, 18h20

Mieux je pense

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Save()
Dim chemin As String
Dim MyDate As String
Dim sNomfichier As String
 
    MyDate = Format(Now(), "dd-mm-yy")
    chemin = ThisWorkbook.Path
    sNomfichier = RenommerFichier(chemin, "Synthèse carnet" & "-" & MyDate & ".xlsb")
    ThisWorkbook.SaveCopyAs Filename:=sNomfichier
End Sub

**ghazalinadou** · 04/09/2017, 10h41

Bonjour,
Vous aviez une idée pour remplissage automatique , si j'ai un champ qui se répète dans plusieurs feuilles au lieu de tapé a chaque fois , il suffit de le résigner dans feuille 1 , et par défaut sera rempli dans les autres pages.
Merci pour vos aides

**Miigui** · 11/09/2017, 10h13

Envoyé par kiki29

Salut, en t'inspirant de cette fonction et en l'adaptant à ton contexte

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
Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object
 
   Set FSO = CreateObject("Scripting.FileSystemObject" )
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)
 
        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000" ) & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing
 
   RenommerFichier = sDossier & "\" & sNomfichier
End Function

Un exemple, qui te permettra de voir l'usage de cette fonction.

Salut! Je viens de tester à mon problème. Le nome de dossier ne s'incrémente pas...

Enregistrer un même fichier avec l'année et un Nº d'indice : File-2017-N°1, File-2017-N°2 ,.., File-2018-N°1

Macros et VBA Excel

Discussions similaires

Partager

Partager