Comment faire ? (excel 2019). Résolu

Question

Bonjour,

Je cherche a sauvegarder mon classeur de 3 manières

1-c: \Images\Trav\......................simplement avec .xlsm
2 - c:\Images\Trav\Trav1\ avec date heure etc. et le mon
3 -c:\Images\Trav\Trav2\ avec date heure etc. et le mon

J'ai besoin que les fichiers avec date etc.. sont limiter en nombre (la dernière Save remplaçant la plus ancienne).

Le code que j'ai marche mais je n'arrive pas à enregistrer les saves dans les dossiers.

Avez-vous une idée.

Merci.

Sub test()
    savefichier "c:\Images\Trav\"
    savefichier "c:\Images\Trav\Trav1\"
    savefichier "c:\Images\Trav\Trav2\"
End Sub

Sub savefichier(Chemin$)
' PatrickToulon
    Dim dat As Date, f, a&, oldfich$
    Chemin = Chemin & "\"
    BaseName = "monfichier"
    dat = Now()
    f = Dir(Chemin & "monfichier*.xls*")
    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(Chemin & f))
        If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = Chemin & f
        f = Dir
    Loop
    If a >= 3 Then Kill oldfich
    ThisWorkbook.SaveCopyAs Chemin & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    ActiveWorkbook.Save
End Sub

Windows / Opera 95.0.0.0

yg_be · Answer

bonjour,

le code marche mais ne fait rien?  peux-tu décrire plus factuellement ton souci?

quand tu partages du code, merci de tenir compte de ceci (le VBA est du Basic): https://codes-sources.commentcamarche.net/faq/11288-poster-un-extrait-de-code

LOUSIAPRAUD · Answer

Bonjour et merci pour cette demande.

Je cherche à sauver un classeur dans 3 répertoires différents.

Le premier simplement avec son nom par ex: fichier.xlsm

Le deuxième avec le nom et la date, heure etc.

Le troisième idm au deuxième.

Pourquoi, : parce que je me sers seulement du premier pour travailler.

Le deuxième est une sauvegarde en cas.

Le troisième part dans un autre service..

J'ai besoin pour le deuxième et troisième de limiter le nombre de sauvegardes à 3 où 4 maxi sachant que la nouvelle sauvegarde remplace la plus ancienne à fur et à mesure.

Mon souci : j'ai bien ce code, qui fonctionne dans la partie "sub saveficchier" mais il ne distribue pas les sauvegardes avec dates heure etc..dans le 2éme et 3éme répertoire. Mais seulement tout dans le 1er . Je ne sais pas comment faire.

Dés le lancement la première partie avec "sub test" ne marche pas et me donne une erreur.

II me dit qu'il ne trouve pas le répertoire  c:\Images\Trav\ fichier-14-03-2023-12h03.xlsm peut être l'avez déplacé etc...Or je n'ai pas demandée à ce stade qu'il soit avec la date, l'heure etc..

J'ai bien regardé , il n'y a pas d'erreur de ma part dans la synthase.

Je suis nulle en VBA., j'ai essayé de l'adapter mais j'ai besoin d'un coup de main .

Merci pour l'aide ainsi que pour l'information sur le dépôt de questions sur le site.

Louisa.P.

LOUSIAPRAUD · Answer

Bonjour,

Simplement le fait que je ne puisse pas sauvegarder le classeur (fichier) dans les bons dossiers.

Sinon moi aussi je n'y comprends rien.

Cordialement

Louisa.P

pijaku · Answer

Bonjour,

Pour limiter à 4 sauvegardes dans le même répertoire : (attention, le code ne fonctionne que si tu n'as, avant toute utilisation, pas déjà plus de 4 sauvegardes)

Const REPERTOIRE_SAVE As String = "D:\Images\Trav\"


Sub Trav()
'UpdateByExtendoffice20160623
ActiveWorkbook.SaveCopyAs REPERTOIRE_SAVE & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs REPERTOIRE_SAVE & "Trav1\" & Format(Now, "dd-mm-yyyy hh""H""mm") & " - " & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs "C:\Images\Trav\Trav2\" & Format(Now, "dd-mm-yyyy hh""H""mm") & " - " & ActiveWorkbook.Name

Call Limiter("xlsm", 4)
End Sub


Public Sub Limiter(ext As String, Nb As Integer)
Dim i As Long, s As String
    i = CountFiles(REPERTOIRE_SAVE, ext, s)
    If i > Nb Then
        If s <> vbNullString Then
            Kill s
        Else
            MsgBox "Erreur, veuillez vérifier votre répertoire"
        End If
   End If
End Sub
Public Function CountFiles(Rep As String, Extens As String, PlusVieux As String) As Long
Dim count As Long, Fichier As String, D As Date, sReturn As String
    If Dir(Rep & "*." & Extens) <> vbNullString Then
        Fichier = Dir(Rep & "*." & Extens)
        D = FileDateTime(Rep & Fichier): PlusVieux = Rep & Fichier
        Do Until Fichier = ""
            count = count + 1
            Fichier = Dir
            If Fichier <> "" Then
                If D > FileDateTime(Rep & Fichier) Then D = FileDateTime(Rep & Fichier): PlusVieux = Rep & Fichier
            End If
        Loop
    End If
    CountFiles = count
End Function

LOUSIAPRAUD · Answer

Bonjour Franck

Merci pour cette solution.

Je vais la tester ce soir et je reviens vers vous demain matin.

Je suis en cours actuellement.

Bonne fin de journée.

Louisa P.

LOUSIAPRAUD · Answer

Bonjour Franck.

J'ai essayée, mais les limitations ne fonctionnent pas . J'ai bien vidée les répertoires avant pour créer les nouvelles sauvegardes.

Mais les répertoires continus à enregistrer la 5éme, la 6éme sauvegarde.. etc..

Bon je laisse tomber , je ferais le nettoyage ( la limitation ) manuellement. Tant pis.

Merci pour l'aide.

Lousia P.

Comment faire ? (excel 2019).

6 réponses

Newsletters