[Réslolu] Enregistrement automatique fichier incrémenté de 1 à chaque enregistrement

[Cougar]

Bonjour le forum,

Est-ce qu'il est possible d'enregistrer automatiquement avec une incrémentation de 1 (à la fin du nom) à chaque enregistrement ?

Donc, nomfichier +1 à chaque enregistrement.

J'utilise ce code pour l'enregistrement (gracieuseté du forum) :

ActiveWorkbook.SaveAs Filename:="S:\aaa\bbb\" & "Fichier planif du " & Sheets("Dimanche").Range("F1") & " au " & Sheets("Samedi").Range("F1") & ".xlsm"

Merci

 

[Bougla972]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Cougar, le forum,

Essaie ce bout de code :

Sub EnregistreAvecIncrementation
Dim Chemin_Repertoire As String, Fichier As String,Fch as String
Dim i As Byte
Fch = "NomFichier_"  & ".xls"
i = 0
Fichier = Dir(Chemin_Repertoire & Fch)'Chemin de répertoire
If Fichier <> "" Then
    Do
        Fichier = Dir(Chemin_Repertoire & "NomFichier_" & Format(NewDate, "dd-mm-yyyy") & "_" & i + 1 & ".xls")
        i = i + 1
    Loop While Fichier <> ""
    ThisWorkbook.SaveCopyAs Chemin_Repertoire & "NomFichier_" & "_" & i + 1 & ".xls" 'Chemin & Fichier
Else
    ThisWorkbook.SaveCopyAs Chemin_Repertoire & Fch
End If
End Sub

A+

Bougla

 

[Cougar]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour le forum, Bougla,

Cela fonctionne en parti.

J'ai modifié ton code mais il ne dépasse 2 ?

Voici le code utilisé:

Dim Chemin_Repertoire As String, Fichier As String, Fch As String
Dim i As Byte

Application.DisplayAlerts = False
Fch = "Fichier planif du " & Sheets("Dimanche").Range("F1") & " au " & Sheets("Samedi").Range("F1") & ".xlsm"
i = 0
Fichier = Dir("S:\Superviseur\Emballage\Planification\" & Fch) 'Chemin de répertoire
If Fichier <> "" Then
Do
Fichier = Dir("S:\Superviseur\Emballage\Planification\" & "NomFichier_" & Format(NewDate, "dd-mm-yyyy") & " # " & i + 1 & ".xlsm")
i = i + 1
Loop While Fichier <> ""
ThisWorkbook.SaveCopyAs "S:\Superviseur\Emballage\Planification\" & "Fichier planif du " & Sheets("Dimanche").Range("F1") & " au " & Sheets("Samedi").Range("F1") & " # " & i + 1 & ".xlsm" 'Chemin & Fichier
Else
ThisWorkbook.SaveCopyAs "S:\Superviseur\Emballage\Planification\" & Fch
End If
End Sub

Merci

 

[Bougla972]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Cougar,

Pourrais tu mettre un mettre à dispo un ex de ton fichier sans infos confidentiel stp pour tester tout cela ?

A +
Bougla

 

[Cougar]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Bougla972,

Voici tel que demandé le fichier joint.

Merci

 

[Bougla972]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Cougar,

Voici le fichier en retour. Dis moi si cela te convient.

A+
Bougla

 

[Cougar]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Bougla,

De mon côté, le s'enregistre mais sans nom ? On voit l'icone d'Excel mais aucun nom à droite. De plus, si je fais un 2e enregistrement, il n'y a pas d'encrémentation de la numérotation.

Merci pour ton aide.

 

[Bougla972]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Re Cougar,

Je pense que cette fois ci c'est la bonne...😉

A+
Bougla

 

[Bougla972]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Oups...une petite erreur...

Remplace la macro par celle-ci:

Sub GenereArchives()
Dim Chemin_Archive As String, Fichier As String, Fch As String
Dim temp As String

    Chemin_Archive = "S:\Superviseur\Emballage\Planification\"'à adapter
    Fch = Replace("Fichier planif du " & Sheets("Lundi").Range("F1") & " au " & Sheets("Feuil2").Range("F1") & ".xlsm", "/", "_") 'Nom d'onglet à adapter
    i = 0
    Fichier = Dir(Chemin_Archive & Fch)
        If Fichier <> "" Then
        Do
            temp = Left(Fch, Len(Fch) - 5)
            Fichier = Dir(Chemin_Archive & temp & "_" & i + 1 & ".xlsm")
            i = i + 1
        Loop While Fichier <> ""
        ThisWorkbook.SaveCopyAs Chemin_Archive & temp & "_" & i & ".xlsm"
        Else
        ThisWorkbook.SaveCopyAs Filename:=Chemin_Archive & temp & ".xlsm"
        End If
End Sub

 

[Cougar]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Bougla,

Même résultat que précédement de mon côté.

Merci

 

[Bougla972]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Cougar,

Le fichier corrigé en retour...

A+
Bougla

 

[Cougar]

Re : Enregistrement automatique du fichier incrémenté de 1 à chaque enregistrement

Bonjour Bougla,

Le tout fonctionne très bien.

Merci énormément pour ton aide