Microsoft 365 Rafraichir fichier toutes les heures

macrout95

XLDnaute Nouveau
Bonjour tout le monde,

J’ai trouvé de bien nombreux postes qui abordent mon sujet ci-dessous mais je n’arrive pas a l’adapter pour mon cas.
Voilà la situation
  • J’ai 2 feuilles Excel avec pour chacune un code VBA différents
    • Module10 que j’ai appelé « Refresh_PMS170 »
    • Module2 que j’ai appelé « Refresh_PMS100 »
1638882399670.png


  • Je fais appel à ces 2 macros dans « ThisWorkbook » afin qu’elles se lancent à l’ouverture de mon fichier, cela me donne donc :

Private Sub Workbook_Open()

' J'appelle les 2 macros une par une :

Application.Run "'Combo PMS170 - PMS100 V11.xlsm'!Refresh_PMS170"

Application.Run "'Combo PMS170 - PMS100 V11.xlsm'!Refresh_PMS100"

' Je retourne sur la page "PMS170"

Sheets("PMS170").Select

' Je sauvegarde

ActiveWorkbook.Save

End Sub



Maintenant ce que je voudrais c’est que ces 2 macros se relancent toutes les heures à partir du moment ou j’ai ouvert mon fichier.
J’ai donc trouve un tas de choses grâce au forum mais je n’arrive pas à l’appliquer.
Au mieux, cela me relance mes macros après une heure mais une seule fois.

Je vous remercie pour votre aide.
Bonne journee
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @macrout95 :),

Un exemple d'utilisation de Application.Ontime pour lancer à intervalles réguliers le rafraichissement.

Le code est commenté (un peu)
  • Il y a du code dans le module de ThisWorkbook
  • Il y a du code dans module1
  • La constante Fréquence indique l'intervalle entre deux rafraichissements (en seconde)
  • La variable Prochain indique l'heure du prochain lancement programmé du rafraichissement

Le code associé à ThisWorkbook:
VB:
Option Explicit

Private Sub Workbook_Open()
   Rafraichir     'on lance le premier rafraichissement
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   On Error Resume Next    ' au cas où il y aurait un PB d'heure
   Application.OnTime EarliestTime:=Prochain, Procedure:="Rafraichir", Schedule:=False    'on arrête la prochaine exécution
   On Error GoTo 0
End Sub

Le code dans Module1:
VB:
Option Explicit
Const Frequence = 5     'intervalle en seconde (=3600 pour une heure)
Public Prochain

Sub Rafraichir()
   On Error Resume Next    ' au cas où il y aurait un PB d'heure
   Application.OnTime EarliestTime:=Prochain, Procedure:="Rafraichir", Schedule:=False    'on arrête la prochaine exécution
   On Error GoTo 0
   MsgBox "Rafraichissement..."     'ICI, placez le code de rafraichissment
   Prochain = Time + Frequence * 1 / 24 / 60 / 60     'heure de la prochaine exécution
   Prochain = Prochain - Int(Prochain)                'au delà de minuit, on enlève 24h
   Application.OnTime EarliestTime:=Prochain, Procedure:="Rafraichir", Schedule:=True     'programmation du prochain lancement
End Sub

Pour l'exemple, on a :
  • défini l'intervalle à 5 secondes
  • remplacé le code de rafraichissement par une instruction MsgBox (à vous de mettre le bon code)
 

Pièces jointes

  • macrout95- Toutes les heures- v1.xlsm
    16 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonjour macrout95, mapomme,

Une autre solution avec ce code dans ThisWorkbook :
Code:
Private Sub Workbook_Open()
Dim nph&, t#, i&, tt#, h#
nph = 60 'nombre d'exécutions PAR HEURE, à adapter
t = Now
For i = 1 To nph * 24
    tt = t + i / nph / 24
    h = tt - Int(CDec(tt)) 'valeur < 1
    Application.OnTime h, Me.CodeName & ".Macro"
Next
End Sub

Sub Macro()
MsgBox "Bonjour à tous"
End Sub
Les heures d'exécution de la macro sont programmées à l'avance.

nph = 60 c'est pour tester, mettre nph = 1 pour une exécution chaque heure.

A+
 

Pièces jointes

  • Relances(1).xlsm
    14.7 KB · Affichages: 4

macrout95

XLDnaute Nouveau
Merci pour vos reponses Messieurs, je retrouve le meme probleme que d'habitude, c'est a dire que je ne sais pas comment utiliser votre code dans le mien (qu'est ce que j'enleve, qu'est ce que je dois modifier...)

Pour ton example job75, je ne sais pas du tout ou inserer tout ca dans mon ThisWorkbook qui ressemble a ca :

Private Sub Workbook_Open()

' J'appelle les 2 macros une par une :

Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS170"
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS100"

' Je retourne sur la page "PMS170"

Sheets("PMS170").Select

' Je sauvegarde

ActiveWorkbook.Save


End Sub


Merci
 

job75

XLDnaute Barbatruc
Mettez dans ThisWorkbook :
VB:
Private Sub Workbook_Open()
Dim nph&, t#, i&, tt#, h#
nph = 1 'nombre d'exécutions PAR HEURE, à adapter
t = Now
For i = 1 To nph * 24
    tt = t + i / nph / 24
    h = tt - Int(CDec(tt)) 'valeur < 1
    Application.OnTime h, Me.CodeName & ".Macro"
Next
End Sub

Sub Macro()
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS170"
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS100"
Me.Sheets("PMS170").Activate
Me.Save
End Sub
 

macrout95

XLDnaute Nouveau
Mettez dans ThisWorkbook :
VB:
Private Sub Workbook_Open()
Dim nph&, t#, i&, tt#, h#
nph = 1 'nombre d'exécutions PAR HEURE, à adapter
t = Now
For i = 1 To nph * 24
    tt = t + i / nph / 24
    h = tt - Int(CDec(tt)) 'valeur < 1
    Application.OnTime h, Me.CodeName & ".Macro"
Next
End Sub

Sub Macro()
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS170"
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS100"
Me.Sheets("PMS170").Activate
Me.Save
End Sub

Je viens de mettre ce code, le probleme est que j'ai ce message d'erreur qui apparait :

1638968904062.png


Sinon cela semble fonctionner, mis le hic c'est que je dois etre constamment devant mon PC pour cliquer sur OK lors de l'apparation de ce message (qui arrive a chaque rafraichissement)

De plus a la place de 1 dans nph j'ai mis 120 (pour faire un test), au debut j'avais un rafraichissement toute les 30 secondes maintenant ca ne s'arrete plus jamais...
 

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
l'idée de @job75 est pas mal (programmer toutes les heure à l'avance )
VB:
Private Sub Workbook_Open()
    Dim i&, finjour&, prochain, heure&, i&
    finjour = 18 'on peut donner une limite  de fin de journée (ici 18 heure)
    Do While heure <= finjour
       i = i + 1: prochain = Now + TimeValue(Format(i, "00") & ":00:00"): heure = Hour(prochain)
        If Hour(prochain) <= finjour Then Application.OnTime prochain, Me.CodeName & ".test"
    Loop
test
End Sub

Sub test()
    MsgBox "salut!!"
    'fait ce que tu veux ici
    'Me.Save
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Concernant mon code, Il suffit de mettre dans la macro Rafraichir votre code:
VB:
Sub Rafraichir()
   On Error Resume Next    ' au cas où il y aurait un PB d'heure
   Application.OnTime EarliestTime:=Prochain, Procedure:="Rafraichir", Schedule:=False    'on arrête la prochaine exécution
   On Error GoTo 0
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS170"
Application.Run "'Combo PMS170 - PMS100 V112312.xlsm'!Refresh_PMS100"
Me.Sheets("PMS170").Activate
Me.Save
   Prochain = Time + Frequence * 1 / 24 / 60 / 60     'heure de la prochaine exécution
   Prochain = Prochain - Int(Prochain)                'au delà de minuit, on enlève 24h
   Application.OnTime EarliestTime:=Prochain, Procedure:="Rafraichir", Schedule:=True     'programmation du prochain lancement
End Sub