Comment faire ? (excel 2019).

Résolu/Fermé
LOUSIAPRAUD Messages postés 8 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 - Modifié le 13 mars 2023 à 19:05
yg_be Messages postés 23473 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 février 2025 - 16 mars 2023 à 09:10

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

LOUSIAPRAUD Messages postés 8 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 2
15 mars 2023 à 16:24

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
LOUSIAPRAUD Messages postés 8 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 2
16 mars 2023 à 05:01

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 23473 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 février 2025 1 568
16 mars 2023 à 09:10

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

0
yg_be Messages postés 23473 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 février 2025 Ambassadeur 1 568
13 mars 2023 à 19:02

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
LOUSIAPRAUD Messages postés 8 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 2
Modifié le 14 mars 2023 à 12:24

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 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 2
14 mars 2023 à 12:19

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 23473 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 février 2025 1 568
14 mars 2023 à 13:11

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
LOUSIAPRAUD Messages postés 8 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 2
14 mars 2023 à 15:12

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 Date d'inscription mardi 7 mars 2023 Statut Membre Dernière intervention 16 mars 2023 2
14 mars 2023 à 15:24

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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
15 mars 2023 à 14:06

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