Sauvegarde d'une nouvelle révision de fichier incrémentée

[chappyporfaro]

Bonjour à tous,

Je suppose que c'est un sujet qui a déjà été abordé mais mes recherches n'aboutissent pas à une solution concrète.

J'aimerais avoir une macro qui gère la révision de mon fichier (en XL2007 ou en XL2003 dépendant la version du fichier de base).

Voilà, j'ai un fichier "Classeur.xlsx" et je voudrais sauvegarder, dans le même répertoire, une nouvelle révision au format "* Rev-xx.xlsx", c'est-à dire : "Classeur Rev-00.xlsx", "Classeur Rev-01.xlsx", "Classeur Rev-02.xlsx", etc. jusqu'à 99.

Mais il faudrait que la macro vérifie s'il y a déjà une ou des révision(s) dans le répertoire et incrémente celle à sauvegarder afin qu'elle soit la dernière :

Exemple :

Présents dans le répertoire :

Classeur.xlsx
Classeur Rev-04.xlsx
Classeur Rev-05.xlsx
Classeur Rev-08.xlsx
Classeur Rev-09.xlsx

Dans ce cas, le nouveau fichier serait enregistré sous le nom "Classeur Rev-10.xlsx" malgré le fait que les versions 00 à 03 et 06 à 07 n'existent pas (il m'arrive de temps à autre d'effacer ou archiver certains fichiers).
​

Merci à tous

Pierre

 

[chappyporfaro]

Re : Sauvegarde d'une nouvelle révision de fichier incrémentée

Bonjour à nouveau,

J'ai déjà une bonne partie de réalisé. Pour les essais, je n'ai pas inclu le code effectuant la sauvegarde. Déjà qu'établir la vérification du nom de fichier est quelque peu ardu pour mes faibles connaissances.

Voici pour l'instant comment ça se présente :

Sub SauveRevFileTest()
On Error GoTo Trappe
' Définition des variables
Dim ActuFile As String, ShortFile As String, NewFile As String, FichierDir As String
Dim numCarTxt As Integer, j As Byte
Dim noRev As Variant
j = 0
ActuFile = ActiveWorkbook.Name
' Affecte le nombre de caractère du nom de fichier à la variable numCarTxt
    numCarTxt = Len(ActiveWorkbook.Name)
    If ActiveWorkbook.FileFormat = xlOpenXMLWorkbook Then
        ShortFile = Left$(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) ' exclut l'extension
        
'   Nouvelle procédure
        If Mid(ShortFile, Len(ShortFile) - 6, 5) = " Rev-" Then ' se termine par " Rev-"?
            noRev = Format(Right(ShortFile, 2), "00")
            For j = 0 To 99
                noRev = Format(noRev + j, "00")
                NewFile = ActiveWorkbook.Path & "\" & Left$(ShortFile, Len(ShortFile) - 2) & noRev & ".xlsx"
                If Dir(NewFile) <> "" Then ' le fichier existe dans le répertoire?
                    MsgBox "Le fichier existe déjà!" & vbCrLf & vbCrLf & "Sauvegarde pas effectuée"
                Else
                    MsgBox "Le fichier a été sauvegardé!" & NewFile
                    GoTo Sortie
                End If
            Next j
        Else
            noRev = 0
            For j = 0 To 99
                noRev = Format(noRev + j, "00")
                NewFile = ActiveWorkbook.Path & "\" & ShortFile & " Rev-" & noRev & ".xlsx"
                If Dir(NewFile) <> "" Then ' le fichier existe dans le répertoire?
                    MsgBox "Le fichier existe déjà!" & vbCrLf & vbCrLf & "Sauvegarde pas effectuée"
                Else
                    MsgBox "Le fichier a été sauvegardé!" & NewFile
                    GoTo Sortie
                End If
            Next j
            Debug.Print NewFile
        End If
    End If
'Sortie de la sous-routine
Sortie:
    On Error Resume Next
    Exit Sub
' Affiche l'erreur dans un message avant de sortir de la sous-routine
Trappe:
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
    Resume Sortie
    
End Sub

Ça semble bien fonctionner sauf la vérification mentionnée précédemment :

Mais il faudrait que la macro vérifie s'il y a déjà une ou des révision(s) dans le répertoire et incrémente celle à sauvegarder afin qu'elle soit la dernière :

Exemple :

Présents dans le répertoire :

Code :
Classeur.xlsx
Classeur Rev-04.xlsx
Classeur Rev-05.xlsx
Classeur Rev-08.xlsx
Classeur Rev-09.xlsx



Dans ce cas, le nouveau fichier serait enregistré sous le nom "Classeur Rev-10.xlsx" malgré le fait que les versions 00 à 03 et 06 à 07 n'existent pas​

Alors, si vous avez des trucs, idées ou suggestions, n'hésitez pas à m'en faire part

Merci

Pierre

 

[kjin]

Re : Sauvegarde d'une nouvelle révision de fichier incrémentée

Bonjour,

Sub SauveRevFileTest()
Dim e$, d$, f$, p$, s$, n$, x%, t(), v
e = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") + 1)
d = ActiveWorkbook.Path & "\*." & e
f = Dir(d)
Do While f <> ""
    If f Like "*Rev-*" & e Then
        p = Split(f, "-")(0)
        s = Split(f, "-")(1)
        n = Split(s, ".")(0)
        If IsNumeric(n) Then
            x = x + 1
            ReDim Preserve t(1 To x)
            t(x) = n * 1
        End If
    End If
    f = Dir()
Loop
On Error Resume Next
v = UBound(t)
On Error GoTo 0
If IsEmpty(v) Then
    MsgBox "aucun fichier trouvé !"
Else
    MsgBox "prochain fichier: " & vbCr & _
    p & "-" & Format(Application.Max(t) + 1, "00") & "." & e
End If
End Sub

Je ne vois pas comment définir l'extension du fichier puisque par définition un fichier "xlsx" ne contient pas de macro
A+
kjin

 

[kjin]

Re : Sauvegarde d'une nouvelle révision de fichier incrémentée

Re,
En testant la version au préalable

Dim e$, d$, f$, p$, s$, n$, x%, t(), v
If Val(Application.Version) >= 12 Then e = "xlsx" Else e = "xls"
'e = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") + 1)
d = ActiveWorkbook.Path & "\*." & e
f = Dir(d)
Do While f <> ""
    If f Like "*Rev-*" & e Then
        p = Split(f, "-")(0)
        s = Split(f, "-")(1)
        n = Split(s, ".")(0)
        If IsNumeric(n) Then
            x = x + 1
            ReDim Preserve t(1 To x)
            t(x) = n * 1
        End If
    End If
    f = Dir()
Loop
On Error Resume Next
v = UBound(t)
On Error GoTo 0
If IsEmpty(v) Then
    MsgBox "aucun fichier trouvé !"
Else
    MsgBox "prochain fichier: " & vbCr & _
    p & "-" & Format(Application.Max(t) + 1, "00") & "." & e
End If
End Sub

A+
kjin

 

[chappyporfaro]

Re : Sauvegarde d'une nouvelle révision de fichier incrémentée

Bonjour kjin,

Merci infiniment, ton code est, de beaucoup, plus simple et efficace que ce que j'avais tenté.

Il y a 2 petites lacunes cependant.

J'avais mal renseigné ma requête au départ concernant la version. Lorsque tu valide l'extension du fichier, tu vérifie la version du logiciel au lieu de celle du fichier. Malgré que j'utilise Excel 2007, je dois parfois travailler en mode compatibilité sur certains fichiers de la version 2003.

Aussi, si dans le même répertoire il existe "Classeur1.xlsx" et ses révisions (Rev-00 à Rev-15) ainsi que "Classeur-1.xlsx" et que c'est ce dernier qui est ouvert et que l'on doive enregistrer une révision, la sous-routine tient compte des autres révisions de premier fichier et va placer la révision de "Classeur-1.xlsx" à Rev-16. Crois-tu qu'il y a un moyen pour différencier les différents fichiers dans un même répertoire? Sinon, j'en tiendrai compte dans la structure de mes répertoires afin de ne pas mélanger les fichiers de types différents.

Merci
Pierre

 

[kjin]

Re : Sauvegarde d'une nouvelle révision de fichier incrémentée

Bonjour,
J'avoue qu'en l'absence d'une explication un peu plus claire je ne vois pas, d'autant que la procédure doit certainement être appelée depuis un fichier externe contenant la macro (xlsm donc), un exemple de listing du dossier contenant les différents fichiers et le résultat escompté serait bienvenu.
A+
kjin

 

[chappyporfaro]

Re : Sauvegarde d'une nouvelle révision de fichier incrémentée

Bonjour kjin,

Effectivement, la macro est appelée depuis un fichier externe.

Voici, en pièce jointe, un exemple de listing de dossier. Si je travaille sur le fichier "Test-Pierre.xlsx" il ne faudrait vérifier que les révisions de celui-ci (dans ce cas, il créerait la révision Rev-02).

Merci beaucoup pour ton aide

Pierre