Comment faire ? (excel 2019).

Résolu
LOUSIAPRAUD Messages postés 8 Statut Membre -  
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   -

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

A voir également:

6 réponses

Réponse 1 / 6
LOUSIAPRAUD Messages postés 8 Statut Membre 2
 

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.
1
Réponse 2 / 6
LOUSIAPRAUD Messages postés 8 Statut Membre 2
 

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.
1
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   1 585
 

peux-tu alors marquer cette discussion comme résolue?

0
Réponse 3 / 6
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 585
 

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
0
Réponse 4 / 6
LOUSIAPRAUD Messages postés 8 Statut Membre 2
 

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.
0
LOUSIAPRAUD Messages postés 8 Statut Membre 2
 

Des le lancement la première partie avec "sub test".....et nom "sub savefichier"...Désolée faute de frappe.

0
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   1 585
 

Je ne comprends pas ce qui fonctionne et ce qui ne fonctionne pas.

0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
LOUSIAPRAUD Messages postés 8 Statut Membre 2
 

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
0
LOUSIAPRAUD Messages postés 8 Statut Membre 2
 

Sinon j'ai ce code qui fonctionne, je m'en sers. Mais là c'est la limitation de 3 des sauvegardes ne marche pas. Pas de problèmes pour a direction des répertoires.

Sub Trav()


'UpdateByExtendoffice20160623
ActiveWorkbook.SaveCopyAs "D:\Images\Trav\" + ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs "D:\Images\Trav\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

ActiveWorkbook.Save


 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") & ".xlsm"
    ActiveWorkbook.Save

  
  Select Case MsgBox(" Les 3 Sauvegardes sont réussies.", , "Toutes les 3 Sauvegardes.")

End Select



End Sub
0
Réponse 6 / 6
pijaku Messages postés 13513 Statut Modérateur 2 763
 

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
0