Temporisation à la milliseconde d'une macro

[rmist]

Bonjour à tous,

Ceci est mon premier message sur le forum, merci de votre indulgence et merci pour votre aide!

j'utilise la fonction Sleep comme présenté ci-dessous. Je souhaite en fait créer un pointeur qui défile le long d'une courbe d'un graphique excel, tout en gérant sa vitesse de défilement.
Pour cela j'appelle de manière récursive une fonction qui met en forme le point de données i (mongraph.maserie.points(i)) et enlève la mise en forme du point i-1 (je mets des marqueurs rouge en x de taille supérieure à ma courbe qui elle est de type XYScattersmoothnomarkers).
J'ai essayé avec application.wait et application.ontime, ça fonctionne, le problème c'est que l'on a une précision à la seconde (arrondi).
Je procède ainsi : mise en forme du point i puis application.wait ou application.ontime ou sleep puis bouclage sur le numéro du point.
Avec wait ou ontime ca marche, je vois bien le pointeur défiler sur mon graphe.
Avec sleep, je ne vois rien, pas de marqueur rouge sur ma courbe, puis à la fin de l'exécution de la macro j'ai bien le dernier point qui est pointé (marqueur rouge). La vitesse est bonne, c'est à dire que lorsque je change la tempo du sleep, le temps avant la fin de l’exécution change selon le "temps de sleeping".
Même en mettant une tempo de 1 seconde de sleep, l'effet de la macro ne se voit pas sauf à la fin ou le dernier point est pointé.
Je précise que je refresh mon graph à chaque incrémentation de l'appel.
Demain je mettrais le code que j'utilise en ligne.


SLeep :

Declare sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

sub Tempo()
MsgBox "Msg 1"
Sleep (1000) ' pause de 1 seconde
MsgBox "Msg 2"
Sleep (3000) ' pause de 3 seconde
MsgBox "Msg 3"
end sub


Rémi

 

[mapomme]

Re : Temporisation à la milliseconde d'une macro

Bonjour rmist,

(...) Ceci est mon premier message sur le forum (...)

Bienvenue sur XLD

(...) Demain je mettrais le code que j'utilise en ligne (...)

C'est bien. Joindre un fichier comprenant les données (anonymes et non confidentielles) ainsi que le code serait encore mieux

Un essai dans le fichier joint. Pour rendre visible le point courant, j'ai rajouté un traitement des évènements en attente par le biais de DoEvents.

Le code dans module1:

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const Tempo = 100

Sub Parcourir()
Dim oldStyle, oldSize, oldRGB, xpt As Point, i&, j&

  ActiveSheet.ChartObjects("Graphique 1").Activate
  For i = 1 To ActiveChart.SeriesCollection(1).Points.Count
    If i > 1 Then
      With ActiveChart.SeriesCollection(1).Points(i - 1)
        .MarkerStyle = oldStyle
        .MarkerSize = oldSize
        .MarkerBackgroundColor = oldRGB
      End With
    End If
      
      With ActiveChart.SeriesCollection(1).Points(i)
        oldStyle = .MarkerStyle
        oldSize = .MarkerSize
        oldRGB = .MarkerBackgroundColor
        .MarkerStyle = 8
        .MarkerSize = 14
        .MarkerBackgroundColor = RGB(255, 0, 0)
      End With
      
      For j = 1 To 2: DoEvents: Next j  'pour visualiser le point
      Sleep Tempo
  Next i
  
  With ActiveChart.SeriesCollection(1).Points(i - 1)
    .MarkerStyle = oldStyle
    .MarkerSize = oldSize
    .MarkerBackgroundColor = oldRGB
  End With
End Sub

 

[rmist]

Re : Temporisation à la milliseconde d'une macro

Merci pour ta réponse ultra rapide et efficace mapomme!

Finalement mettre mon code sur le forum n'aura pas servi puisque j'ai switché sur le tien qui est mieux codé je pense.
Je me suis permis quand même de sortir le cas i =1 pour éviter un if à chaque itération.
En fait je n'ai pas pu utiliser ce programme comme je le souhaitais car le temps de calcul est non négligeable devant le temps de tempo...c'est dommage.
Quand je mets 0 milliseconde de tempo il me faut plusieurs secondes pour exécuter la macro.
Les vitesses de défilement que je veux sont trop élevées pour utiliser cette macro.

Je te pose donc mon problème plus général, tu pourras peux-être m'aider :

je souhaite faire un montage vidéo d'un crash test avec d'un côté la vidéo du crash et de l'autre côté le graphe des mesures que j'ai faites lors du crash avec le pointeur qui défile, les deux étant bien-sûr synchronisés dans le temps...
J'avais donc besoin de gérer la vitesse de défilement du pointeur sur le graphe pour l'enregistrer en vidéo (capture écran vidéo) puis de la recaler sur le temps du crash test.

Je ne sais pas si je suis parvenu à être clair, mais si tu as des idées, elles seraient les bienvenues )

Merci beaucoup !

Rémi

 

[Modeste geedee]

Re : Temporisation à la milliseconde d'une macro

Bonsour®
ne pourrais-tu mettre ici (pièce jointe)
les données du graphe et le graphe

 

[Dranreb]

Re : Temporisation à la milliseconde d'une macro

Bonsoir à tous.
Il me semble que le temps spécifié au Sleep s'ajoute au temps du traitement. Voir s'il ne serait pas plus judicieux de combiner quelque chose plutôt avec un Timer système.
À tester prudemment :

Option Explicit
Private NbrDéclen As Long
Private Declare Function SetTimer Lib "user32.dll" _
   (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" _
   (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public Sub LancerTimer(DuréeEntreTops As Long)
Rem. —— Lancer le timer pour une durée désirée entre chaque top.
'       Remarque: ce timer se désactivera de lui même après 10 déclenchements non consultés
NbrDéclen = 0
SetTimer 0, 0, DuréeEntreTops, AddressOf MonTimer
End Sub

Public Function TimerTop() As Boolean
Rem. —— Juste avant action à synchroniser faire: Do Until TimerTop: Loop
DoEvents
TimerTop = NbrDéclen > 0
If TimerTop Then NbrDéclen = NbrDéclen - 1
End Function
'

Private Sub MonTimer(ByVal hwnd As Long, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Long)
NbrDéclen = NbrDéclen + 1
If NbrDéclen > 9 Then KillTimer 0, idEvent
End Sub

Ne surtout pas modifier MonTimer pour qu'il engage lui même des actions: très dangereux.

 

[mapomme]

Re : Temporisation à la milliseconde d'une macro

Bonsoir rmist, Modeste geedee, Dranreb, JCGL,

Par une autre méthode qui consiste à déplacer une forme (cercle rouge) successivement sur chaque point de la courbe.

C'est plus rapide que la version v1. C'est le DoEvents (avec Tempo=0) qui fixe un seuil minimum, mais sans cette instruction, le déplacement de la forme n'est pas perçu.

Sur ma vieille bouse, la durée pour 37 points est d'environ 0,063 à 0.067 secondes (un tout petit plus long si enregistré en .xlsm)

Le code:

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const Tempo = 0

Sub Parcourir()

Dim xy(1 To 999, 1 To 2), Npoints&, x0 As Double, y0 As Double
Dim shp As Shape, pnt As Point, crt As Series
Dim i&, T0 As Single

'initialisation
Set shp = ActiveSheet.Shapes("Oval 1")
x0 = Worksheets("Feuil1").ChartObjects(1).Left
y0 = Worksheets("Feuil1").ChartObjects(1).Top
shp.Left = x0: shp.Top = y0
Set crt = Worksheets("Feuil1").ChartObjects(1).Chart.SeriesCollection(1)

'calcul des coordonnées successives
Npoints = crt.Points.Count
For i = 1 To Npoints
  Set pnt = crt.Points(i)
  xy(i, 1) = pnt.Left + x0: xy(i, 2) = pnt.Top + y0
Next i
  
'parcours de la courbe
T0 = Timer
For i = 1 To Npoints
  shp.Left = xy(i, 1): shp.Top = xy(i, 2)
  shp.Visible = msoCTrue
  DoEvents
  Sleep Tempo
Next i
  DoEvents
  Sleep Tempo
  
'Fin et affichage
T0 = Timer - T0
shp.Left = x0: shp.Top = y0
MsgBox "Durée parcours : " & Format(T0, "0.000") & " sec. " & vbLf & vbLf & _
  " soit " & Format(T0 / Npoints, "0.000") & " sec. par point"
End Sub

 

[mapomme]

Re : Temporisation à la milliseconde d'une macro

Bonsoir rmist, Modeste geedee, Dranreb, JCGL,

Sans aucune prétention, une tentative de synchronisation avec une courbe de temps.
.

• En X, l'échelle des temps (cumulés) de chaque mesure (en millisecondes).
• En Y, les valeurs mesurées à chaque temps.
• En H2, la durée minimum et approximative nécessaire à l'affichage d'un point (millisec.). Durée évaluée sommairement avec la fonction Sub Test_Temps_Affichage_Min(). Sur ma vieille bécane, au moins 16 millisecondes.
• En H3, la durée maximum entre deux mesures.

Après avoir bidouillé, j'en arrive à penser que:

L'ordre de la milliseconde est impossible sur ma bécane pour les raisons suivantes:
.

• la durée minimale d'exécution induite par les instructions dans la boucle d'affichage
• la durée nécessaire au système et à la carte graphique pour déplacer le cercle (chez moi une vieille NVIDIA GeForce 8600 GTS, modèle créé en Avril 2007 )
• peut-être aussi des évènements stockés dans la pile et traités au moment du DoEvents

Sur ma bécane, j'estime que pour afficher et voir chaque point (même si c'est rapide), le seuil min. est vraisemblablement d'environ 20 à 25 millisecondes.

Mais dans le cas d'un crash test, il me semble que, bien souvent, la video est passée au ralenti pour que l'oeil puisse suivre. Dans ce cas, on n'est plus au niveau de l'ordre de la milliseconde.

Je ne certifie en rien la pertinence de mes dires

 

[Modeste geedee]

Re : Temporisation à la milliseconde d'une macro

Bonsour®

Après avoir bidouillé, j'en arrive à penser que:

L'ordre de la milliseconde est impossible sur ma bécane

• le seuil min. est vraisemblablement d'environ 20 à 25 millisecondes.
  Je ne certifie en rien la pertinence de mes dires

il m semble que le seuil soit la durée de rafraichissement+la durée de l'instruction DoEvents (IRQ windows 18ms) -

 

[rmist]

Re : Temporisation à la milliseconde d'une macro

Bonsoir à tous,

Merci beaucoup pour vos réponses j'avais pensé à afficher un point qui parcourt ma courbe comme tu me le propose mapomme mais je n'ai pas eu le temps d'essayer, je testerai ta solution, en tout cas merci.

Pour en revenir au problème de base, à savoir la Synchro d'une video avec ma courbe, effectivement je n'ai pas vraiment besoin de la milliseconde, mais c'etait bien pratique.
Je m'explique :
la courbe est échantillonnée à 25khz, soit 1 point tous les 0,04 millisecondes. Ma vidéo est quant à elle filmée à un frame rate variable selon les essais (entre 5000 et 8000 img/sec) et la lecture est faite à une vitesse de x img/sec (10 environ je ne m'en rappelle plus exactement). En gros je connais exactement la durée entre deux images et je souhaitais ajuster la vitesse de défilement de ma courbe à cette durée.

En y repensant bien, c'était tout simplement stupide de vouloir être à la milliseconde près car je dois recaler environ 5 ms de temps de choc soit au maximum 40 images (disons 4secondes de film). Ces 5 millisecondes de choc représentent 125 points de mesures. Il suffit donc que je fasse défiler ces 125 points en 4 secondes , soit 32ms par point.


Dans le pire des cas, je ralenti ma vidéo et c'est bon.

Du coup j'ai deux questions subsidiaires:

Connaissez vous un logiciel libre et simple de montage video?
Comment assembler 2 vidéos avec des frame rates différents?

Merci à tous pour votre aide!

 

[mapomme]

Re : Temporisation à la milliseconde d'une macro

Bonsoir rmist

(...) Connaissez vous un logiciel libre et simple de montage video?
Comment assembler 2 vidéos avec des frame rates différents? (...)

Je suis une bille en vidéo. Même convertir des vidéos d'un format à un autre me semble compliqué voire ésotérique

 

[Dranreb]

Re : Temporisation à la milliseconde d'une macro

Bonsoir.
Il devrait être possible, si l'animation permet de suivre, de la cadencer à la microseconde près avec ces autres API:

Option Explicit
Private Type LARGE_INTEGER: LowPart As Long: HighPart As Long: End Type
Private Declare Function QueryPerformanceFrequency Lib "kernel32.dll" (ByRef lpFrequency As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32.dll" (ByRef lpPerformanceCount As LARGE_INTEGER) As Long
Public CyclesRéf As Long

Function DuréeCycles(Optional ByVal Cycles As Long = 1) As Double
DuréeCycles = Cycles / CyclesParSec
End Function

Function CyclesParSec(Optional ByVal Sec As Double = 1#) As Long
Dim Fréq As LARGE_INTEGER
If QueryPerformanceFrequency(Fréq) = 0 Then
   MsgBox "Minuteur haute précision non disponible.", vbCritical, "CyclesParSec"
ElseIf Fréq.LowPart < 0 Or Fréq.HighPart <> 0 Then
   MsgBox "Minuteur haute précision: fréquence improbable.", vbCritical, "CyclesParSec"
ElseIf Sec <> 1 Then
   CyclesParSec = Int(Fréq.LowPart * Sec + 0.5)
Else
   CyclesParSec = Fréq.LowPart: End If
End Function

Function CyclesDif() As Long
CyclesDif = CyclesCptr - CyclesRéf: If CyclesDif < 0 Then CyclesDif = CyclesDif + &H40000000
End Function

Function Synchroniser(ByVal Cycles As Long)
Do: DoEvents: Loop Until CyclesDif > Cycles
CyclesRéf = CyclesRéf + Cycles And &H3FFFFFFF
End Function

Function CyclesCptr() As Long
Dim Cptr As LARGE_INTEGER, Cycles As Long
If QueryPerformanceCounter(Cptr) = 0 Then
   MsgBox "Minuteur haute précision non disponible.", vbCritical, "CyclesCptr": Exit Function: End If
Cycles = Cptr.LowPart And &H3FFFFFFF
End Function

Je les découvre seulement et viens d'écrire tout ça, il reste à le tester…

 

[rmist]

Re : Temporisation à la milliseconde d'une macro

Oulala Dranreb tu m'as perdu là...

Pourrais-tu m'expliquer stp?
Vu le nom des fonctions et variables j'ai une idée de ce que ce code fait mais je ne vois pas comment arriver à synchroniser ma courbe et vidéo? Est-ce qu'Excel permettrais de faire ça directement?
Je pourrais éventuellement décomposer mes vidéos en images (de même pour le défilement du graphe) et resynchroniser le tout sous excel?

Mapomme ne t'en fais pas merci quand même

 

[Dranreb]

Re : Temporisation à la milliseconde d'une macro

Non, il n'est pas apte à permettre une synchronisation, mais il devrait permettre, en attendant, de dérouler les deux processus en continu à la même vitesse. Si ça peut se faire image par image ce serait beaucoup plus simple puisqu'il suffirait d'avancer au coup par coup dans le graphe au moyen d'un bouton toupie par exemple. Je rappelle qu'on n'a jamais eu de fichier pour voir comment ça se présente, ni voir comment gagner du temps sur le traitement qui met en évidence le point.

 

[Modeste geedee]

Re : Temporisation à la milliseconde d'une macro

Bonsour®

il suffirait d'avancer au coup par coup dans le graphe au moyen d'un bouton toupie par exemple.

pour le fun :