Executer une macro a interval de temps regulier ?

O

orka

XLDnaute Nouveau
Bonjour
Pour executer une macro a interval de temps j'ai mis cette macro dans ThisworkBook Source

Private Sub Workbook_Open()
Sheets("Club").Select // celle ci est pour ouvrir le classeur sur un onglet defini//
Application.OnTime Now + TimeValue("00:01:00"), "sauvegarde"
End Sub
Cliquez pour agrandir...

Mais cela n'a pas l'air de fonctionner .... une erreur peut etre ??

Merci
Cdlt
 
Trier par date Trier par votes
piga25

piga25

XLDnaute Barbatruc
Re : Executer une macro a interval de temps regulier ?

Bonjour,

Peut être comme ceci

Code: 
Private Sub Workbook_Open()
Sheets("Club").Select // celle ci est pour ouvrir le classeur sur un onglet defini//
NextTime = Now + TimeValue(("00:01:00")
Application.OnTime NextTime, "sauvegarde"
End Sub
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Executer une macro a interval de temps regulier ?

Bonsoir,
A tester
Dans le module de ThisWorkBook
Code: 
Private Sub Workbook_Open()
LanceSauvegarde
End Sub
Dans un module standard
Code: 
Dim Temps As Variant
Sub LanceSauvegarde()
Temps = Now + TimeValue("00:01:00")
Application.OnTime Temps, "LanceSauvegarde"
Sauvegarde 'nom de la macro à lancer
End Sub

Sub Sauvegarde()
'...la procédure
End Sub

Sub StopSauvegarde() 'à associer pour stopper la relance de la procédure
On Error Resume Next
Application.OnTime Temps, "LanceSauvegarde", , False
End Sub
Ne sachant pas ce que fait la macro sauvegarde, il peut être nécessaire de rendre la main au système pour le traitement
A+
kjin
 
Vote positif 0 Vote négatif
piga25

piga25

XLDnaute Barbatruc
Re : Executer une macro a interval de temps regulier ?

Bonjour,

c'est la parenthèse qui est en rouge qui est en trop, désolé lorsque j'ai fait cela (par copier coller) je n'ai pas vérifié.
Code: 
Private Sub Workbook_Open()
Sheets("Club").Select // celle ci est pour ouvrir le classeur sur un onglet defini//
NextTime = Now + TimeValue[COLOR=red][B]([/B][/COLOR]("00:01:00")
Application.OnTime NextTime, "sauvegarde"
End Sub

voila ce que je voulais faire; Voir si cela est conforme !!!
Code: 
Private Sub Workbook_Open()
Sheets("Club").Select // celle ci est pour ouvrir le classeur sur un onglet defini//
NextTime = Now + TimeValue ("00:01:00")
Application.OnTime NextTime, "sauvegarde"
End Sub
 
Vote positif 0 Vote négatif
piga25

piga25

XLDnaute Barbatruc
Re : Executer une macro a interval de temps regulier ?

Bonjour,

Si c'est une macro qui se déclenche à interval régulier pour faire une sauvegarde, regarde celles-ci. Elle fonctionnent très bien, dans un userform, on choisi si on veut sauvegarder, puis le delai entre chaque sauvegarde et enfin le nombre de sauvegarde que l'on garde.

Les macros sont de : John Walkenbach, de Iznogood et de el-Joker(mpfe)


Code: 
'avec l'aide de John Walkenbach, de Iznogood et de el-Joker(mpfe)
 
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 
Public Delai
Public Dossier
Public NbFicMax
Dim Nom
Public NextTime
Sub CopieSauvegardeAuto()
    NextTime = Now + TimeValue(Delai)
    Application.OnTime NextTime, "sauve"
End Sub
 
Sub Sauve()
Dim strDate As String
Count = Len(ActiveWorkbook.Name)
Nom = Left(ActiveWorkbook.Name, Count - 4)
strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
ThisWorkbook.SaveCopyAs Filename:=Dossier & Nom & strDate & ".xltm"
DeleteEnTrop (Dossier)
CopieSauvegardeAuto
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & "\"
Else
GetDirectory = ""
End If
End Function
 
Sub ChoixDelai()
Delai = InputBox("Entrez sous la forme hh:mm:ss le délai souhaité entre deux sauvegardes" _
& Chr(10) & "ex : 00:30:00 pour enregistrer toutes les 30 minutes", , "00:30:00")
End Sub
Sub ChoixNbSauvegardes()
NbFicMax = InputBox("Combien de sauvegardes voulez vous garder ?" _
& "seules les plus récentes sont conservées", , "4")
End Sub
 
Sub DeleteEnTrop(path)
Dim Fic As String
Dim Tabl() As Variant
Dim i As Integer
'Stocker les noms et les dates de sauvegarde des
'archives dans un tableau
ReDim Tabl(1, 0)
Fic = Dir(path)
Do While Fic <> ""
  ReDim Preserve Tabl(1, UBound(Tabl, 2) + 1)
  Tabl(0, UBound(Tabl, 2)) = Fic
  Tabl(1, UBound(Tabl, 2)) = FileDateTime(path & Fic)
  Fic = Dir
Loop
'S'il y a plus de fichiers que défini dans NbMax
'on trie le tableau des archives par date décroissante
'et on efface les premiers pour n'en laissser
'que le nombre choisi dans NbMax
If UBound(Tabl, 2) > NbFicMax Then
  Tri Tabl, 1, UBound(Tabl, 2)
  For i = UBound(Tabl, 2) To NbFicMax + 1 Step -1
   Kill path & Tabl(0, i)
  Next i
End If
End Sub
'Procédure récursive classique
'de tri adaptée au tri d'un
'tableau à 2 dimensions
Sub Tri(ByRef Liste As Variant, ByVal Bas As Long, ByVal Haut As Long)
Dim i  As Long, j As Long
Dim Milieu As Variant, Echange As Variant
  i = Bas
  j = Haut
  Milieu = Liste(1, Int(Bas + Haut) / 2)
  Do
    While Liste(1, i) > Milieu
      i = i + 1
    Wend
    While Milieu > Liste(1, j)
      j = j - 1
    Wend
    If i <= j Then
      Echange = Liste(1, i)
      Liste(1, i) = Liste(1, j)
      Liste(1, j) = Echange
      Echange = Liste(0, i)
      Liste(0, i) = Liste(0, j)
      Liste(0, j) = Echange
      i = i + 1
      j = j - 1
    End If
  Loop Until i > j
  If Bas < j Then Tri Liste, Bas, j
  If i < Haut Then Tri Liste, i, Haut
End Sub
 
Vote positif 0 Vote négatif
O

orka

XLDnaute Nouveau
Re : Executer une macro a interval de temps regulier ?

piga25 à dit:
Bonjour,

c'est la parenthèse qui est en rouge qui est en trop, désolé lorsque j'ai fait cela (par copier coller) je n'ai pas vérifié.
Code: 
Private Sub Workbook_Open()
Sheets("Club").Select // celle ci est pour ouvrir le classeur sur un onglet defini//
NextTime = Now + TimeValue[COLOR=red][B]([/B][/COLOR]("00:01:00")
Application.OnTime NextTime, "sauvegarde"
End Sub

voila ce que je voulais faire; Voir si cela est conforme !!!
Code: 
Private Sub Workbook_Open()
Sheets("Club").Select // celle ci est pour ouvrir le classeur sur un onglet defini//
NextTime = Now + TimeValue ("00:01:00")
Application.OnTime NextTime, "sauvegarde"
End Sub
Cliquez pour agrandir...

Merci de ta reponse , mais cela ne fonctionne pas :(
cdlt
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2016 RESOLU _ Reset le minuteur si Userform Actif et activité sur Userform
Réponses
14
Affichages
336
Dranreb
Dranreb
R
  • Question
Microsoft 365 Verifier l'execution continue de la macro
Réponses
1
Affichages
333
Dranreb
Dranreb
I
  • Résolu(e)
Microsoft 365 [RESOLU] Boucler sur une partie de code
Réponses
5
Affichages
411
Icedarts
I
P
  • Question
XL 2016 Erreur macro non disponible dans le classeur ou macro non activée
Réponses
6
Affichages
707
pesca37
P
C
  • Question
XL 2010 ecran d'affichage mise a jour heure précise.
Réponses
6
Affichages
748
Modeste geedee
Modeste geedee
I
  • Résolu(e)
Microsoft 365 Macro erreur 438 suite passage sur 365
Réponses
12
Affichages
871
isataz
I
F
  • Question
XL 2019 Avis macro sur classeur maître
Réponses
0
Affichages
596
Fanrs
F
J
  • Question
XL 2016 Erreur 1004 sur un fichier copié par VBA
Réponses
0
Affichages
688
JPrev
J
J
  • Question
XL 2016 Procédure de fermeture automatique de fichier
Réponses
6
Affichages
1 K
krimoines
K
M
  • Question
XL 2016 VBA > Réactualisation d'un TCD à l'ouverture du fichier qui ne passe pas
Réponses
3
Affichages
1 K
Phil69970
Phil69970

Membres actuellement en ligne

6 membres et 63 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 321
Messages
2 087 265
Membres
103 501
dernier inscrit
talebafia