Autres Séquenceur (Timer) dans autre instance d'Excel

jurassic pork · 16 Mai 2025

Hello,
EN VBA pour exécuter des routines à intervalles réguliers on a Application.OnTime mais hélas ceci est limité à un intervalle min de 1 seconde.
Il y a les API windows Timers mais elles peuvent faire planter Excel.
Il y a la classe stdTimer.cls du projet stdVBA qui utilise une autre instance d'Excel mais elle a deux inconvénients : 1 on crée un classeur et on
injecte du code dedans. Si cela se passe mal dans cette instance, elle reste dans le gestionnaire du tâche même après fermeture du classeur principal.
Alors, il m'est venu une idée : pourquoi ne pas ouvrir dans une nouvelle instance, un classeur avec le code d'un séquenceur.

Code:

Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Private tim As Boolean, ms_ As Long, app_ As Application, wbk_ As Workbook, fonction_ As String

Sub StartSeq(ms As Long, app As Application, wbk As Workbook, fonction As String)
  ms_ = ms: Set wbk_ = wbk: fonction_ = fonction: Set app_ = app
  Application.OnTime Now, "StartSequenceur" ' démarrage par événement pour ne pas avoir StartSeq bloquant
End Sub
Sub StopSeq()
  tim = False
End Sub
Function StartSequenceur()
    Dim x As Integer
    tim = True
    On Error Resume Next
    Do While tim = True
        ' Pause pour réduire la charge processeur
        x = 0
        Do While x < ms_ / 20: x = x + 1: Sleep 20: DoEvents: Loop
       ' Appeler la fonction spécifiée
          app_.Run fonction_
        DoEvents
    Loop
End Function

et voici le code du classeur de démo :

VB:

Private xlAppTimer As Application
Sub LaunchSequencer()
   If xlAppTimer Is Nothing Then
       Set xlAppTimer = CreateObject("Excel.Application")
       xlAppTimer.Workbooks.Open "D:\Dev\Office\Excel\timerJP.xlsm"
       xlAppTimer.Visible = False
   End If
    xlAppTimer.Run "StartSeq", 100, Application, ThisWorkbook, "TestProcedure" ' call "TestProcedure" toutes les 100 ms
End Sub
Sub StopSequencer()
    xlAppTimer.Run "StopSeq"
End Sub
Sub CleanAppTimer()
    If Not xlAppTimer Is Nothing Then
       xlAppTimer.Run "StopSeq"
       xlAppTimer.Workbooks("timerJP.xlsm").Close
       xlAppTimer.Quit
       Set xlAppTimer = Nothing
    End If
End Sub
Public Sub TestProcedure()
     [A1] = Time
End Sub

On démarre le séquenceur en passant comme paramètres: l'intervalle de temps, l'objet Application , le classeur actif , la procédure à appeler.
Le CleanTimer ferme l'instance qui a été ouverte pour timerJP.xlsm

Si vous voyez des failles ou des améliorations à apporter, n'hésitez pas à le dire.

Ami calmant, J.P

dysorthographie · 16 Mai 2025

Bonjour,
Perso j'utilise ça

Code:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MyTimer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, _
        ByVal nIDEvent As LongPtr) As LongPtr
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, _
        ByVal nIDEvent As Long) As Long
#End If

Private TimerID
Private m_Interval As Long

Public Property Let Interval(ByVal Value As Long)
    If CBool(Value) Then
        StartTimer Value
    Else
        StopTimer
    End If
End Property
Public Property Get Started() As Boolean
Started = m_Interval
End Property
Private Sub StartTimer(ByVal Interval As Long)
    If Interval <= 0 Then Exit Sub ' Vérifier si l'intervalle est valide
    m_Interval = Interval

    ' Créer un timer avec l'intervalle spécifié
    TimerID = SetTimer(0, 0, m_Interval, AddressOf Tic)
End Sub

Private Sub StopTimer()
    ' Arrêter le timer
    KillTimer 0, TimerID
    m_Interval = 0
End Sub


Private Sub Class_Terminate()
StopTimer
End Sub

Il faut bien-sûr avoir la sub tic dans un module standard

Code:

 dim T as new MyTimer
Sub test()
T.inerval=10 'start timer 10 millisecondes
T.interval=0  ' Stop le timer
End sub
Sub Tic()
End sub

jurassic pork · 17 Mai 2025

dysorthographie à dit:

Bonjour,
Perso j'utilise ça

Code:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MyTimer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, _
        ByVal nIDEvent As LongPtr) As LongPtr
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, _
        ByVal nIDEvent As Long) As Long
#End If

Private TimerID
Private m_Interval As Long

Public Property Let Interval(ByVal Value As Long)
    If CBool(Value) Then
        StartTimer Value
    Else
        StopTimer
    End If
End Property
Public Property Get Started() As Boolean
Started = m_Interval
End Property
Private Sub StartTimer(ByVal Interval As Long)
    If Interval <= 0 Then Exit Sub ' Vérifier si l'intervalle est valide
    m_Interval = Interval

    ' Créer un timer avec l'intervalle spécifié
    TimerID = SetTimer(0, 0, m_Interval, AddressOf Tic)
End Sub

Private Sub StopTimer()
    ' Arrêter le timer
    KillTimer 0, TimerID
    m_Interval = 0
End Sub


Private Sub Class_Terminate()
StopTimer
End Sub

Il faut bien-sûr avoir la sub tic dans un module standard

Code:

 dim T as new MyTimer
Sub test()
T.inerval=10 'start timer 10 millisecondes
T.interval=0  ' Stop le timer
End sub
Sub Tic()
End sub

Hello,
j'étais un peu sceptique, vu ce que j'avais écrit dans mon premier message :

Il y a les API windows Timers mais elles peuvent faire planter Excel.

Mais j'ai essayé ta classe dans mon classeur de test avec ceci dans un module :

VB:

Dim T As New MyTimer
Sub StartApiTimer()
T.Interval = 100 'start timer 100 millisecondes
End Sub
Sub Tic()
On Error Resume Next
   [A1] = Time
End Sub
Sub StopApiTimer()
T.Interval = 0 ' Stop le timer
End Sub

avec une procédure Tic équivalente à la procédure que j'utilise pour mon Séquenceur d'instance Excel.
Et bien ave le

Code:

On Error Resume Next

cela ne plante pas avec le Timer lancé si on est en Edition de cellule ou bien si on est dans l'Editeur VBA. Sans cette instruction, j'ai un crash.
Donc l'important c'est que le code que l'on appelle ne plante pas ou ne s'arrête pas pendant l'exécution du Timer.
Ami calmant, J.P

Rheeem · 17 Mai 2025

SetTimer comme le reste des api si elle n'est pas fermé correctement l'application plante
il y a une technique qui consiste à placer le code du callback dans une zone de mémoire et pas dans le module pour éviter le débogage

GitHub - thetrik/VbTrickTimer: CTrickTimer - the timer class for VB6/VBA compatible with 64 bit office.

CTrickTimer - the timer class for VB6/VBA compatible with 64 bit office. - thetrik/VbTrickTimer

github.com

dysorthographie · 17 Mai 2025

Bonjour,
Dernière le timer li y a un détournement de l'interruption 1c qui est le retour timer du BIOS.

Avant l'avanement de winXp il étais possible de gérer va VB6. XP et consorts ont interdit ce genre de pratique car ça plantait l'ordinateur.

Les appi ont le droit de le faire mais le fait de ne pas restituer l'interruption via la clôture de l'API plante l'application {excel en l'occurrence} mais plus le système.

L'avantage d'une classe c'est qu'elle dispose de la méthode terminat ce qui permet de clôturer l'API implicitement et automatiquement.

J'avoue n'avoir pas bousculer dans ces retranchements le module de classe. Je l'ai implémenter après une longue recherche de documents pour XLD.

Perso j'utilise l'activex timer de VB6.

Dranreb · 17 Mai 2025

Bonjour.
Je rappelle que j'ai une classe Rythmeur d'utilisation simple permettant des exécutions périodique dans tout module objet via un évènement Intervient. Elle utilise un module standard XRythmeur dont toutes les procédure ne sont utilisées que par les objets de ce type. Ce système demeure hélas sensible à toute tentative d'exécution, durant la prise en charge de l'évènement si elle intervient au cours d'une phase de calcul d'Excel, d'une de ses méthode concernant autre chose que des Shape, ce qui le fait aussitôt planter.
Joindre un classeur où vous voudriez que je vous l'y implante …

Effectuez une recherche sur Excel Downloads...

Autres Séquenceur (Timer) dans autre instance d'Excel

jurassic pork

XLDnaute Accro

Pièces jointes

dysorthographie

XLDnaute Accro

jurassic pork

XLDnaute Accro

Rheeem

XLDnaute Junior

GitHub - thetrik/VbTrickTimer: CTrickTimer - the timer class for VB6/VBA compatible with 64 bit office.

dysorthographie

XLDnaute Accro

Dranreb

XLDnaute Barbatruc

Discussions similaires

Nous accordons de l'importance à votre vie privée