Discussion :

[nirvana4483]

Bonjour les gens
Je ne suis pas un développeur, plutôt un bidouilleur qui s'aide avec google et ChatGPT

j'ai un souci, je souhaite effectuer une sauvegarde automatique de mon onglet caché LOG à 5H35, 13H35 et 21H35
Eviter les sauvegardes doublons, que la routine se lance automatiquement à l'ouverture du fichier (qui a vocation à rester ouvert H24)

Si je ferme le fichier et l'ouvre à 7H, j'ai bien ma sauvegarde de 13H35 qui s'effectue, par contre plus de sauvegarde après

j'ai tout supprimé dans le planificateur de tâches au cas ou, j'ai juste une tâche qui tourne en fond toute les 10 minutes qui ouvre et ferme l'invite de commande pour que le pc ne puisse jamais s'éteindre

voilà je suis bloqué.. :-(



dans l'onglet ThisWorkBook

j'ai mis cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Sub Workbook_Open() 'Actions effectuées à l'ouverture du fichier
    Application.ScreenUpdating = False
    Feuil1.Activate
    unprot 'Déprotection de toutes les feuilles ainsi que du classeurs
    recherche_port
    tare
    Application.Wait Now + TimeValue("0:00:01")
    pesee
    prot 'Protection de toutes les feuilles ainsi que du classeurs
    Application.ScreenUpdating = True
 
 
 
    ' Ajout lancement Save_Auto_Log à l'ouverture du fichier 29/02:24
    ' Déclencher la première exécution à 5h du matin
    Application.OnTime TimeValue("05:30:00"), "Save_Auto_Log.CopierOngletLOG"
    ' Déclencher la deuxième exécution à 13h
    Application.OnTime TimeValue("13:30:00"), "Save_Auto_Log.CopierOngletLOG"
    ' Déclencher la troisième exécution à 21h
    Application.OnTime TimeValue("21:30:00"), "Save_Auto_Log.CopierOngletLOG"
 
Application.ScreenUpdating = True
 
End Sub

j'ai un module Save_Auto_Log

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
' A ajouter dans la macro Workbook_Open() dans ThisWorkbook  29/02:24
    ' Déclencher la première exécution à 5h du matin
    'Application.OnTime TimeValue("05:00:00"), "Save_Auto_Log.CopierOngletLOG"
    ' Déclencher la deuxième exécution à 13h
    'Application.OnTime TimeValue("13:00:00"), "Save_Auto_Log.CopierOngletLOG"
    ' Déclencher la troisième exécution à 21h
    'Application.OnTime TimeValue("21:00:00"), "Save_Auto_Log.CopierOngletLOG"
 
Sub CopierOngletLOG()
 
    ' Variable statique pour suivre si la macro est déjà en cours d'exécution
    Static isRunning As Boolean
    ' Vérifie si la macro est déjà en cours d'exécution
    If isRunning Then Exit Sub
    ' Marquer la macro comme étant en cours d'exécution
    isRunning = True
 
 
    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wsLOG As Worksheet
    Dim destFilePath As String
    Dim destFileName As String
    Dim destPath As String
    Application.DisplayAlerts = False
 
Application.ScreenUpdating = False
    ' Définir le chemin de destination
    destPath = "E:\Save_Auto_Log\"
 
    ' Ouvrir le classeur source
    Set wbSource = ThisWorkbook
    ' Déprotéger le classeur
    wbSource.Unprotect "admin"
    ' Afficher l'onglet caché LOG
    Set wsLOG = wbSource.Sheets("LOG")
    wsLOG.Visible = xlSheetVisible
 
    ' Copier l'onglet LOG
    wsLOG.Copy
 
    ' Obtenir le nouveau classeur créé
    Set wbDest = ActiveWorkbook
 
    ' Enregistrer le nouveau classeur avec un nom dynamique
    destFileName = "Save_Auto_Log_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsx"
    destFilePath = destPath & destFileName
    wbDest.SaveAs destFilePath
 
    ' Fermer le nouveau classeur sans enregistrer les modifications dans le classeur source
    wbDest.Close SaveChanges:=False
 
    ' Masquer à nouveau l'onglet LOG
    wsLOG.Visible = xlSheetHidden
 
    ' Protéger le classeur à nouveau si nécessaire
    wbSource.Protect "admin"
 
    ' Planifier la prochaine exécution
    ThisWorkbook.Workbook_Open
    Application.ScreenUpdating = True
End Sub

[Franc]

Salut, voici une solution à tester. Dans ThisWorkBook tu insères ces 2 macros:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Workbook_Open()
    Application.ScreenUpdating = False
    Feuil1.Activate
    unprot 'Déprotection de toutes les feuilles ainsi que du classeurs
    recherche_port
    tare
    Application.Wait Now + TimeValue("0:00:01")
    pesee
    prot 'Protection de toutes les feuilles ainsi que du classeurs
    Application.ScreenUpdating = True
 
    ' Calculer la prochaine heure de sauvegarde
    Dim nextHour As Date
    nextHour = GetNextSaveTime(Time)
 
    ' Planifier la prochaine exécution
    Application.OnTime nextHour, "Save_Auto_Log.CopierOngletLOG"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Function GetNextSaveTime(currentTime As Date) As Date
    ' Heures de sauvegarde
    Const saveHours As String = "5:35,13:35,21:35"
 
    ' Tableau des heures de sauvegarde
    Dim hoursArray() As String
    hoursArray = Split(saveHours, ",")
 
    ' Heure actuelle
    Dim heure As Integer
    heure = hour(currentTime)
 
    ' Minute actuelle
    Dim minutes As Integer
    minutes = minute(currentTime)
 
    ' Trouver la prochaine heure de sauvegarde
    Dim nextHour As Integer
    nextHour = -1
    Dim i As Byte
    For i = 0 To UBound(hoursArray)
        Dim h As Variant
        h = Split(hoursArray(i), ":")
        If heure < h(0) Or (heure = h(0) And minutes < h(1)) Then
            nextHour = h(0)
            Exit For
        End If
    Next i
 
    ' Si aucune heure de sauvegarde n'a été trouvée, utiliser la première heure de sauvegarde du lendemain
    If nextHour = -1 Then
        nextHour = Split(hoursArray(0), ":")(0)
        GetNextSaveTime = Date + 1 + TimeSerial(nextHour, Split(hoursArray(0), ":")(1), 0)
    Else
        GetNextSaveTime = Date + TimeSerial(nextHour, Split(hoursArray(i), ":")(1), 0)
    End If
End Function

Modifie ces lignes dans ta macro CopierOngletLOG

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    ' Planifier la prochaine exécution
    Dim nextHour As Date
    nextHour = GetNextSaveTime(Time)
    Application.OnTime nextHour, "Save_Auto_Log.CopierOngletLOG"

[nirvana4483]

j'ai modifié mon code mais j'ai quelques souci





je peux aussi envoyer mon fichier Excel si besoin

[nirvana4483]

je pense il faut déclarer la variable nextHour quelque part?

[Valtrase]

Bonjour,
Teste ceci :
Coupe et colle la fonction : Function GetNextSaveTime(currentTime As Date)As Date dans le module Save_Auto_Log puis passe-la en public.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Public Function GetNextSaveTime(ByVal currentTime As Date) As Date
    '...
    '...
End Function

[nirvana4483]

Alors j'ai bien coupé et collé la fonction : Function GetNextSaveTime(currentTime As Date)As Date dans le module Save_Auto_Log et mis en Public

en test, cela fonctionne pour 10h40 et 10h41 et pas 10h42

j'avais un peu le même souci avec ma macro de base, hier j'ai eu ma sauvegarde de 13h30, 21h30 et rien à 5h30
Et je dois le fermer le fichier le matin et le rouvrir et j'ai la sauvegarde de 13h30 et 21h30. Si je le ferme pas le fichier le matin, la sauvegarde ne fonctionne plus et est arrêtée
=>cela était avec mon code initial

maintenant j'ai mis votre code

en gros je souhaite une sauvegarde des logs sur 3 vacations, car on tourne en 3*8, et que cela ne s'arrête jamais et si le fichier est fermé et ouvert cela se relance seul

[Valtrase]

Re,
IL ne doit pas y avoir de raison, mais les intervalles sont courts...

[nirvana4483]

c'est juste pour le test les intervalles là
je ne peux être présent à 5H30, 13H30 et 21H30

mais entre mon code et le code fourni grâce à vous, la boucle ne tourne pas complètement et s'arrête

je peux ressayer avec des intervalles plus longs exemple 12h00 12h05 12h10, mais je reste septique

[nirvana4483]

Salut, voici une solution à tester. Dans ThisWorkBook tu insères ces 2 macros:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Workbook_Open()
    Application.ScreenUpdating = False
    Feuil1.Activate
    unprot 'Déprotection de toutes les feuilles ainsi que du classeurs
    recherche_port
    tare
    Application.Wait Now + TimeValue("0:00:01")
    pesee
    prot 'Protection de toutes les feuilles ainsi que du classeurs
    Application.ScreenUpdating = True
 
    ' Calculer la prochaine heure de sauvegarde
    Dim nextHour As Date
    nextHour = GetNextSaveTime(Time)
 
    ' Planifier la prochaine exécution
    Application.OnTime nextHour, "Save_Auto_Log.CopierOngletLOG"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Function GetNextSaveTime(currentTime As Date) As Date
    ' Heures de sauvegarde
    Const saveHours As String = "5:35,13:35,21:35"
 
    ' Tableau des heures de sauvegarde
    Dim hoursArray() As String
    hoursArray = Split(saveHours, ",")
 
    ' Heure actuelle
    Dim heure As Integer
    heure = hour(currentTime)
 
    ' Minute actuelle
    Dim minutes As Integer
    minutes = minute(currentTime)
 
    ' Trouver la prochaine heure de sauvegarde
    Dim nextHour As Integer
    nextHour = -1
    Dim i As Byte
    For i = 0 To UBound(hoursArray)
        Dim h As Variant
        h = Split(hoursArray(i), ":")
        If heure < h(0) Or (heure = h(0) And minutes < h(1)) Then
            nextHour = h(0)
            Exit For
        End If
    Next i
 
    ' Si aucune heure de sauvegarde n'a été trouvée, utiliser la première heure de sauvegarde du lendemain
    If nextHour = -1 Then
        nextHour = Split(hoursArray(0), ":")(0)
        GetNextSaveTime = Date + 1 + TimeSerial(nextHour, Split(hoursArray(0), ":")(1), 0)
    Else
        GetNextSaveTime = Date + TimeSerial(nextHour, Split(hoursArray(i), ":")(1), 0)
    End If
End Function

Modifie ces lignes dans ta macro CopierOngletLOG

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    ' Planifier la prochaine exécution
    Dim nextHour As Date
    nextHour = GetNextSaveTime(Time)
    Application.OnTime nextHour, "Save_Auto_Log.CopierOngletLOG"

j'ai modifié avec ton code mais la boucle de sauvegarde s'arrête à la 2ième sauvegardes, voir mes autres messages

[Valtrase]

Bonjour,
Pour ma part j'ai fait un test et tout se passe comme il faut. Voir capture d'écran ci-dessous.



Maintenant avec un dépassement :

Bien regarder la constante saveHours sur les deux exemples.

[nirvana4483]

comment on affiche cette fenêtre?

[Valtrase]

Bonjour,
Dans le menu affichage du VBE Affichage/Fenêtre exécution ou bien CTRL + G
Il est fortement conseillé d'utiliser les fenêtres variables locales, et fenêtre espions qui peuvent rendre de sérieux services en mode dépannage.

Un peu de lecture : https://learn.microsoft.com/fr-fr/of...help/view-menu

[nirvana4483]

échec pour moi :-(
Auriez vous votre fichier Excel à partager que je teste et essai d'intégrer cela dans le mien

[Valtrase]

Bonjour,

échec pour moi :-(
Auriez vous votre fichier Excel à partager que je teste et essai d'intégrer cela dans le mien

Oupss... J'ai égaré ma boule de cristal, il nous faut plus d'information là.

[Nain porte koi]

J'ai égaré ma boule de cristal

Elle à une fâcheuse tendance à se planquer juste quand on en a besoin
Idem avec les décodeurs, ils tombent en panne juste quand il faut pas

[nirvana4483]

j'ai essayé de tester votre solution, et je n'arrive pas à solutionner mon problème
mon souhait est de sauvegarder un onglet à 5h35,13h35 et 21h35

le problème est que la boucle s'arrête

[nirvana4483]

j'ai essayé autrement j'ai la première sauvegarde qui se fait et pas les 2 autres... Ca me fait péter un plomb

dans ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Sub Workbook_Open()
    ' Définir les horaires de sauvegarde
    Dim saveTimes(2) As Date
    saveTimes(0) = TimeValue("12:10:00")
    saveTimes(1) = TimeValue("12:11:00")
    saveTimes(2) = TimeValue("12:12:00")
 
    ' Planifier l'exécution de la sauvegarde pour chaque horaire spécifié
    Dim i As Integer
    For i = LBound(saveTimes) To UBound(saveTimes)
        Application.OnTime TimeValue(saveTimes(i)), "SaveLogAtTime"
    Next i
End Sub

dans un module nommé Save_Auto_Log

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Public Sub CopierOngletLOG()
 
    ' Variable statique pour suivre si la macro est déjà en cours d'exécution
    Static isRunning As Boolean
    ' Vérifie si la macro est déjà en cours d'exécution
    If isRunning Then Exit Sub
    ' Marquer la macro comme étant en cours d'exécution
    isRunning = True
 
 
    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wsLOG As Worksheet
    Dim destFilePath As String
    Dim destFileName As String
    Dim destPath As String
    Application.DisplayAlerts = False
 
Application.ScreenUpdating = False
    ' Définir le chemin de destination
    destPath = "C:\Users\lf060863\Documents\test sauvegarde\"
 
    ' Ouvrir le classeur source
    Set wbSource = ThisWorkbook
    ' Déprotéger le classeur
    wbSource.Unprotect "admin"
    ' Afficher l'onglet caché LOG
    Set wsLOG = wbSource.Sheets("LOG")
    wsLOG.Visible = xlSheetVisible
 
    ' Copier l'onglet LOG
    wsLOG.Copy
 
    ' Obtenir le nouveau classeur créé
    Set wbDest = ActiveWorkbook
 
    ' Enregistrer le nouveau classeur avec un nom dynamique
    destFileName = "Save_Auto_Log_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsx"
    destFilePath = destPath & destFileName
    wbDest.SaveAs destFilePath
 
    ' Fermer le nouveau classeur sans enregistrer les modifications dans le classeur source
    wbDest.Close SaveChanges:=False
 
    ' Masquer à nouveau l'onglet LOG
    wsLOG.Visible = xlSheetHidden
 
    ' Protéger le classeur à nouveau si nécessaire
    wbSource.Protect "admin"
 
    ' Planifier la prochaine exécution
         Application.Run "ThisWorkbook.Workbook_Open"
 
    Application.ScreenUpdating = True
End Sub
 
Public Sub SaveLogAtTime()
    ' Appeler la fonction de sauvegarde de l'onglet Log (à implémenter)
    Application.Run "Save_Auto_Log.CopierOngletLog"
End Sub

[Valtrase]

Bonjour,
Quelques petits points :
Il est très déconseillé d'utiliser les procédure évènementielles directement. Workbook_Open() en est une, il vaut mieux créer un procédure publique que tu colles dans un module, et tu appelle cette procédure quand tu en a besoin.
D'autrepart, isRunning est déclarer Static il garde donc son état à chaque retour dans la procédure, néanmoins il n'est nulle-part remis à False.
j'ai fait un petit test chez moi et tout se passe comme il le faut, voir les captures d'écrans :



donc si je ne me suis pas trompé cela devrait ressembler à cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Sub Workbook_Open()
    Application.ScreenUpdating = False
    Feuil1.Activate
    Application.ScreenUpdating = True

    ' // Initialise la prochaine sauvegarde
    RunOnTime
End Sub

Function GetNextSaveTime(currentTime As Date) As Date
    ' // Heures de sauvegarde
    Const saveHours As String = "17:04,17:05,17:06"

    ' // Tableau des heures de sauvegarde
    Dim hoursArray() As String
    hoursArray = Split(saveHours, ",")

    ' Heure actuelle
    Dim heure As Integer
    heure = Hour(currentTime)

    ' // Minute actuelle
    Dim minutes As Integer
    minutes = Minute(currentTime)

    ' // Trouver la prochaine heure de sauvegarde
    Dim nextHour As Integer
    nextHour = -1
    Dim i As Byte
    For i = 0 To UBound(hoursArray)
        Dim h As Variant
        h = Split(hoursArray(i), ":")
        If heure < h(0) Or (heure = h(0) And minutes < h(1)) Then
            nextHour = h(0)
            Exit For
        End If
    Next i

    ' // Si aucune heure de sauvegarde n'a été trouvée, utiliser la première heure de sauvegarde du lendemain
    If nextHour = -1 Then
        nextHour = Split(hoursArray(0), ":")(0)
        GetNextSaveTime = Date + 1 + TimeSerial(nextHour, Split(hoursArray(0), ":")(1), 0)
    Else
        GetNextSaveTime = Date + TimeSerial(nextHour, Split(hoursArray(i), ":")(1), 0)
    End If
End Function

Sub CopierOngletLOG()
    Const DESTINATION_PATH As String = "E:\Save_Auto_Log\"

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    With ThisWorkbook
        .Unprotect "admin"

        Dim wsLOG As Worksheet
        Set wsLOG = .Worksheets.Item("LOG")
        With wsLOG
            .Visible = xlSheetVisible
            .Unprotect "admin"
            .Copy
        End With
    End With

    With ActiveWorkbook
        ' // Enregistrer le nouveau classeur avec un nom dynamique
        Dim destinationFileName As String
        destinationFileName = "Save_Auto_Log_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsx"

        Dim destinationFullPath As String
        destinationFullPath = DESTINATION_PATH & destinationFileName
        .SaveAs destinationFullPath
        .Close SaveChanges:=False
    End With
    wsLOG.Visible = xlSheetHidden '// Masquer à nouveau l'onglet LOG
    ThisWorkbook.Protect "admin" ' // Protéger le classeur à nouveau si nécessaire

    ' // Planifier la prochaine exécution
    RunOnTime

    Application.ScreenUpdating = True
End Sub

' // LA PROCEDURE RunOnTime() EST A METTRE DANS UN MODULE :

Public Sub RunOnTime()
    Dim nextHour As Date
    nextHour = GetNextSaveTime(Time)
    ' // Planifier la prochaine exécution
    ' Application.OnTime nextHour, "Maprocedure"
    Application.OnTime nextHour, "Save_Auto_Log.CopierOngletLOG"
End Sub

'Sub MaProcedure()
'    MsgBox "Exécution... " & Format(Time, "hh:mm")
'    ' // On initialise la prochaine sauvegarde
'    RunOnTime
'End Sub

[Nain porte koi]

Hello, je m'immisce, désolé

Il est très déconseillé d'utiliser les procédure évènementielles directement. Workbook_Open() en est une, il vaut mieux créer un procédure publique que tu colles dans un module, et tu appelle cette procédure quand tu en a besoin.

Vous pouvez préciser le pourquoi c'est déconseillé svp ?
J'ai souvent utilisé Workbook_BeforeClose et je voudrai bien comprendre pourquoi ça serait mieux de mettre le code ailleurs vu qu'il n'est utilisé que là ; pour moi ça multiplie les sub et complique un peu la lecture du code, non ?

[Valtrase]

Bonjour,

Vous pouvez préciser le pourquoi c'est déconseillé svp ?

Le sujet est traité sur le blog de Pierre Fauconnier, il en parlera surement mieux que moi.