Nom de fichier unique

[chappyporfaro]

Bonjour le forum,

J'ai récupéré un bout de code je ne sais plus trop dans quel fil mais j'aimerais l'optimiser:

    ThisWorkbook.SaveAs ThisWorkbook.Path & "\MonFichier" & Format(Now, " yy-mm-dd @ hh\h mm\m ss\s") & ".xls"

Ce code sert à enregistrer un fichier sous le nom: "MonFichier 10-04-08 @ 14h 39m 52s.xls" dans son répertoire d'origine et où "MonFichier" est un nom fixé dans le code. Moi, ce que je voudrais serait qu'au départ, je crée un fichier (pour l'exemple "MonFichier.xls"). Il est le fichier originel et je veux qu'à chaque sauvegarde ou fermeture, une copie incrémentée soit créée dans le même style. C'est cette copie incrémentée que j'utiliserai par la suite pour travailler.

Mais je voudrais que ce soit réutilisable pour d'autres fichiers sans que l'on aie à aller modifier le préfixe du nom de fichier directement dans le code. Je m'explique: Si je crée à nouveau un fichier qui s'appellerait par exemple "MonFichier256.xls", le code détecte automatiquement que c'est le fichier originel et utilise ce nouveau nom comme préfixe.

Je ne sais pas trop si (et comment) je devrais vérifier la présence de la date et l'heure dans le fichier présentement.... Ou me servir de la première partie de la chaîne de caractère du nom de fichier en extrayant la partie contenant la date et l'heure. Dans ce cas, je devrai quand même valider s'il s'agit du fichier originel ou non. Pouvez-vous m'aider dans cet enlignement S.V.P.?

Je ne sais pas si c'est assez clair pour vous. Je joint un fichier exemple contenant le dit code.

 

[JNP]

Re : Nom de fichier unique

Bonsoir ChappyPorfaro ,
Pas sûr d'avoir tout compris (je ne parles pas le québécois couramment ), mais tu peux faire ce type de test sur le fichier

Sub test()
Dim MonTest
MonTest = Split(ThisWorkbook.Name, " ")
If UBound(MonTest) > 4 Then
If Right(MonTest(5), 5) = "s.xls" And Right(MonTest(4), 1) = "m" And _
     Right(MonTest(3), 1) = "h" And Right(MonTest(2), 1) = "@" Then
MsgBox "Ce fichier est une copie"
Exit Sub
End If
End If
MsgBox "Ce fichier est l'original"
End Sub

Bonne soirée

 

[chappyporfaro]

Re : Nom de fichier unique

Bonjour JNP,

C'est une très bonne piste de solution pour la comparaison et je vais probablement l'adopter.

Resterait à savoir comment extraire le début du nom du fichier pour qu'il soit utilisable. Avec le fichier d'origine, je devrais retirer le ".xls", tandis qu'avec une copie contenant la date et l'heure comme dans mon exemple plus haut, je dois retirer ces dernières. En me servant du premier espace comme repère peut-être?

Si on a "abcdefghijkl" et qu'on veut retirer les 5 derniers caractères de la chaîne pour déposer le résultat dans une variable "string". Comment fait-on pour "déconcaténer" une chaîne de caractère?

Merci de m'accorder de ton précieux temps

 

[kjin]

Re : Nom de fichier unique

Bonsoir,
Peut-être suis-je à coté, mais ne pourrais-tu pas mettre le numéro dans une cellule de ton classeur de travail et incrémenter ce N° à chaque enregistrement.
Il faudra par précaution, supprimer tout le code vba du classeur nouvellement créé.
A+
kjin

 

[chappyporfaro]

Re : Nom de fichier unique

Bonsoir,
Peut-être suis-je à coté, mais ne pourrais-tu pas mettre le numéro dans une cellule de ton classeur de travail et incrémenter ce N° à chaque enregistrement.
Il faudra par précaution, supprimer tout le code vba du classeur nouvellement créé.
A+
kjin

Bonsoir kjin, ta méthode compliquerait les choses car ça obligerait l'utilisateur à se discipliner sur une méthode de création de fichier et tout le reste. Et que dire si un autre utilisateur s'ajoute ....

Je préfèrerais continuer de travailler au niveau de la chaîne de caractères mais je manque un peu de connaissances à ce niveau. Mais je ne doute pas qu'un pro va donner son avis très bientôt.

Merci quand même

Bye

 

[JNP]

Re : Nom de fichier unique

Re ,

Je préfèrerais continuer de travailler au niveau de la chaîne de caractères mais je manque un peu de connaissances à ce niveau. Mais je ne doute pas qu'un pro va donner son avis très bientôt.

Pas très gentil pour Kjin qui est un pro ...
Si tu décortiques mon code, tu t'apercevras qu'il suffit de concaténer proprement MonTest pour obtenir le nom de fichier original, soit

Sub test()
Dim MonTest, I As Integer, NomFichier As String
MonTest = Split(ThisWorkbook.Name, " ")
If UBound(MonTest) > 4 Then
If Right(MonTest(UBound(MonTest)), 5) = "s.xls" And Right(MonTest(UBound(MonTest) - 1), 1) = "m" And _
     Right(MonTest(UBound(MonTest) - 2), 1) = "h" And Right(MonTest(UBound(MonTest) - 3), 1) = "@" Then
If UBound(MonTest) = 5 Then
NomFichier = MonTest(0) & ".xls"
Else
NomFichier = MonTest(0)
For I = LBound(MonTest) + 1 To UBound(MonTest) - 5
NomFichier = NomFichier & " " & MonTest(I)
Next I
NomFichier = NomFichier & ".xls"
End If
MsgBox "Ce fichier est une copie" & vbCrLf & "L'original s'appelle " & NomFichier
Exit Sub
End If
End If
MsgBox "Ce fichier est l'original"
End Sub

Bonne journée

 

[chappyporfaro]

Re : Nom de fichier unique

Bonjour à tous,

Désolé kjin de t'avoir manqué de respect. Je me relirai 2 fois plutôt qu'une avant de publier.

JNP, ton code semble très bien fonctionner. De plus, il semble prendre en compte que le nom du fichier d'origine peut contenir des espaces. Je vais travailler un peu les choses pour intégrer ma procédure de sauvegarde à ce code et ça devrait fonctionner ... en principe... Je vous tiens au courant des développements.

Un gros merci

 

[chappyporfaro]

Re : Nom de fichier unique

Après quelques essais concluant, voici ce que ça donnerait:

Sub SauveNomUnique()
On Error GoTo Trappe
' Définition des variables
Dim MonTest, I As Integer, NomFichier As String
Dim numCarTxt As Integer
' Affecte le nombre de caractère du nom de fichier à la variable numCarTxt
    numCarTxt = Len(ActiveWorkbook.Name)
 
' Définition du tableau MonTest à partir du nom du fichier avec les espaces comme séparateurs
    MonTest = Split(ActiveWorkbook.Name, " ")
 
' Validation du fichier d'origine. La comparaison vérifie les types de caractères contenu dans le tableau.
    If UBound(MonTest) > 4 Then
        If Right(MonTest(UBound(MonTest)), 5) = "s.xls" And Right(MonTest(UBound(MonTest) - 1), 1) = "m" And _
             Right(MonTest(UBound(MonTest) - 2), 1) = "h" And Right(MonTest(UBound(MonTest) - 3), 1) = "@" Then
            If UBound(MonTest) = 5 Then
                NomFichier = MonTest(0) ' & ".xls"
            Else
                NomFichier = MonTest(0)
                For I = LBound(MonTest) + 1 To UBound(MonTest) - 5
                    NomFichier = NomFichier & " " & MonTest(I)
                Next I
                'NomFichier = NomFichier & ".xls"
            End If
            MsgBox "Ce fichier est une copie" & vbCrLf & "L'original s'appelle " & NomFichier
            ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & NomFichier & _
                                Format(Now, " yy-mm-dd @ hh\h mm\m ss\s") & ".xls"
            Exit Sub
        End If
    Else
        NomFichier = Left$(ActiveWorkbook.Name, numCarTxt - 4)
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & NomFichier & _
                            Format(Now, " yy-mm-dd @ hh\h mm\m ss\s") & ".xls"
        Exit Sub
    End If
 
Sortie:
    On Error Resume Next
    Exit Sub
 
Trappe:
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
    Resume Sortie
 
End Sub

Si vous croyez que l'on peut optimiser ce code, je suis ouvert à toute suggestion. Je l'ai intégré à un fichier masqué qui se charge automatiquement à l'ouverture d'Excel. La procédure peut donc être appelée à partir de n'importe quel autre fichier ouvert sans avoir à recopier le code. Vraiment "nice"

Merci pour les précieux conseils et les procédures d'origine. s

PS: J'aurais aimé partager le fichier mais il est trop gros. Alors s'il y a des intéressés, je peux vous l'envoyer par email

Bye