Discussion :

[ghazalinadou]

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]

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]

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

[kiki29]

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]

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]

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

[Miigui]

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...