XLS : Créer une animation fluide sans Crash (ou presque) !

[Lu76Fer]

Bonjour à toutes et tous, camarades codeurs !

J'ai codé récemment dans un autre projet des animations pour agrémenter celui-ci et j'ai donc été confronté à des problèmes d'arrêt brutal de ma boucle d'animation lors d'une saisie dans une cellule. En cherchant à améliorer le contrôle d'animation j'ai déterré un petit projet sous Excel 2003 dans lequel une animation se mettait en pause lors de la saisie d'une cellule mais se poursuivait ensuite normalement.
Après avoir longuement cherché ce que j'avais bien pu coder pour éviter le plantage de ma boucle d'animation j'ai finalement extrait la fonction qui permet cela. En faite, lorsque l'on saisie une cellule, cela "verrouille" les objets Excel et génère une erreur dans la boucle d'animation. Je suppose que si on écrit dans une cellule cela "empêche Excel" d'afficher l'erreur à l'écran mais la boucle est "crashée".

Il est possible de rajouter une gestion de l'erreur dans la boucle mais le plus efficace est de détecter le "verrouillage" et de ne pas poursuivre l'animation ou la suspendre. Je vous présente ci-dessous ma solution :​

Module des fonctions de temporisation
Je commence d'abord par la présentation du module des fonctions permettant de créer des pauses entre chaque étape de l'animation et qui exploite les fonctions système 'Sleep' et 'GetTickCount':

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

Private Const SYS_SPANTIME = 10     'Temps accordé au système à chaque itération

Public Const PERCEPT_TIME = 125     'Human Percepting Time(100ms) with margin
Public Const CHECK_TIME = 250       'Laps de temps pour une vérification cyclique

'Rem. : instant ou relève horloge désigne le temps écoulé depuis le démarrage de la machine en ms
Private LngStartTimer As Long   'Défini l'instant de départ
Private LastCheckClock As Long  'Dernière relève horloge

'Macro réalisant une pause d'une durée = period en ms
Public Sub SystemPause(period As Long)
Dim lStartTimer As Long
    lStartTimer = GetTickCount()
    Do
        Sleep SYS_SPANTIME: DoEvents
        LastCheckClock = GetTickCount()
    Loop While (LastCheckClock - lStartTimer) < period
End Sub

'Définir l'instant de départ pour WaitSpanTime
Sub StartTimer()
    LngStartTimer = GetTickCount()
End Sub

'Macro réalisant une courte pause d'une durée = period en ms
'   startNow : si faux, l'instant de départ est celui enregistré par StartTimer
'   pauseOnCellWriting : si vrai, réalise une pause tant qu'Excel est verrouillé (ex: en écrivant dans une cellule)
Sub WaitSpanTime(period As Long, Optional startNow = True, Optional pauseOnCellWriting As Boolean = True)
Dim lTime As Long
    If startNow Then LngStartTimer = GetTickCount()
    Do
        DoEvents
        LastCheckClock = GetTickCount()
        lTime = period - (LastCheckClock - LngStartTimer)
    Loop While lTime > 0
    'Contrôle si l'utilisateur 'saisie' une cellule
    If pauseOnCellWriting Then
        While (IsCellWriting())
            SystemPause CHECK_TIME
        Wend
    End If
End Sub

'Contrôle si Excel est verrouillé(retour=True)
'   Condition : si la feuille active est protégée il faut que l'attribut UserInterfaceOnly:=True
' ait été utilisé avec 'Protect' sinon la fonction renvoie toujours 'True'
Function IsCellWriting() As Boolean
    On Error GoTo writeCell
    [A1] = [A1] 'Impossible en cours d'écriture
    Exit Function
writeCell:
    IsCellWriting = True
End Function

'Donne le temps écoulé en ms depuis la dernière pause ou la pause en cours
'   Procédures de 'pause' : SystemPause & WaitSpanTime
Function GetTimeLastAskPause() As Long
    GetTimeLastAskPause = GetTickCount() - LastCheckClock
End Function

'Donne le temps écoulé depuis le démarrage de la machine en ms
Function GetSystemTime() As Long
    GetSystemTime = GetTickCount()
End Function

La fonction principale est WaitSpanTime qui permet de créer une toute petite pause et peut assurer la fluidité d'une animation. Je n'ai pas utilisé Sleep dans cette fonction car après expérimentation cette fonction n'est pas utile et ruine la fluidité. En faite, l'appel à DoEvents suffit car il redonne la main à Excel qui assure l'affichage de l'animation.
Voici un petit test que vous pouvez faire :
Ajoutez un Sleep(10) dans une boucle d'animation, cela va redonner du temps au système (Windows). En passant la souris au dessus de l'animation, vous allez vous rendre compte que celle-ci Freeze car du coup le système va raffraîchir l'affichage du curseur de la souris au détriment de votre animation. C'est très flagrant comme test et, à contrario, en retirant votre Sleep vous verrez que votre animation reste parfaitement fluide.
Il est ensuite possible d'homogénéiser chaque étape de l'animation en s'assurant qu'elle prenne le même temps en passant le deuxième paramètre startNow à False. Dans ce cas l'instant de départ sera déterminé au moment de l'appel à la procédure StartTimer. Voici l'algorithme simplifié dans notre boucle d'animation :

StartTimer
{Préparation de l'étape suivante de l'animation}
WaitSpanTime 50, False

Ainsi on tient compte du temps de préparation de l'animation.
Le dernier argument pauseOnCellWriting, mis à False, permet de désactiver la mise en pause si Excel 'se verrouille'. Certaines animations agissent sur des paramètres qui ne sont pas bloqués par Excel et peuvent donc continuer à se dérouler même si l'utilisateur saisie une cellule, cependant je déconseillerais de désactiver cette option.
Remarque : l'appel à la fonction IsCellWriting doit se situer juste après la procédure DoEvents qui à son appel, permet à Excel de récupèrer la main et de 'verrouiller les objets'. A ce moment, IsCellWriting boucle sur la procédure SystemPause ce qui met en pause l'animation et évite le 'plantage' de celle-ci.

La procédure SystemPause contrairement à WaitSpanTime est utile pour réaliser une simple pause et redonne la main à Excel (DoEvents) et aussi au système (Sleep).

La fonction IsCellWriting comme indiqué en commentaire ne fonctionne, avec une feuille protégée, qu'à la condition d'avoir l'attribut UserInterfaceOnly à True.
Remarque : l'attribut UserInterfaceOnly n'est pas sauvé dans le classeur, il faut donc toujours le réactiver à l'ouverture du classeur.
Par exemple dans le module de la feuille :

Public Sub Init()
    Me.Unprotect
    Me.Protect DrawingObjects:=True, UserInterfaceOnly:=True ', (...)
End Sub

Les fonctions GetTimeLastAskPause et GetSystemTime sont utiles pour le module suivant ...

Module d'Animation
Ce module apporte des fonctions qui permettent d'éviter à une boucle d'animation de démarrer alors qu'une autre boucle était en train de s'exécuter.
Remarque sur l'empilement de process :
Lorsqu'un process est en cours et que l'on en lance un nouveau, le 1er se 'met en "pause" et le nouveau se déroule normalement et à la fin de celui-ci, le 1er process "poursuit" son exécution. Il est possible "d'empiler" plusieurs process cependant cela rend le code instable. Dans ce cas, le fait, par exemple, d'écrire dans une cellule, peut dans certain cas, provoquer le crash d'Excel !!

Private StoppingAnim As Boolean, StopTime As Long

'Lance l'animation 'sMacro'
'   sRecoverMacro : si définie, macro lancée, en cas de 'crash' de l'animation, juste avant le lancement de l'animation suivante
Sub StartAnim(sMacro As String, Optional sRecoverMacro As String = "")
Static prvMacro As String, prvRecMac As String
Static nxtMacro As String, nxtRecMac As String
    If IsAnimRunning() Then nxtMacro = sMacro: nxtRecMac = sRecoverMacro: Exit Sub
    If StoppingAnim Then StoppingAnim = False: If prvRecMac <> "" Then Run prvRecMac, prvMacro
    prvMacro = sMacro: prvRecMac = sRecoverMacro
callAnim:
    Run sMacro
    StoppingAnim = False    'Réinit
    StopTime = GetSystemTime()
    If nxtMacro <> "" Then
        sMacro = nxtMacro: sRecoverMacro = nxtRecMac
        nxtMacro = "": nxtRecMac = ""
        GoTo callAnim
    End If
End Sub

'Ordonne l'arrêt de l'animation en cours (cet ordre ne peut être lancé qu'après 1/4 de s suite à l'arrêt de la dernière animation)
Sub StopAnim()
Dim crtTime As Long
    crtTime = GetSystemTime()
    If (crtTime - StopTime) > CHECK_TIME And Not (StoppingAnim) Then If IsAnimRunning() Then StoppingAnim = True
End Sub

'Permet de savoir si l'animation doit s'arrêter
Function AnimIsStopping() As Boolean
    AnimIsStopping = StoppingAnim
End Function

'Permet de déterminer si une animation s'exécute
'   Renvoie True si une animation est en cours ou en pause
' depuis moins d'1/4 de seconde
Function IsAnimRunning() As Boolean
    If GetTimeLastAskPause() < CHECK_TIME Then IsAnimRunning = True
End Function

La procédure StartAnim permet de gérer l'exécution des animations en évitant tout chevauchement lors de l'enchaînement d'une animation à une autre. Ensuite, il y a aussi une gestion en cas de plantage d'une animation qui permet de prévoir une macro de recouvrement (Réinit) pour chaque animation.
Les macros sMacro et sRecoverMacro ne doivent pas avoir d'arguments.
Remarque : pour les positionner dans un module de Feuille, il faut renommer la feuille dans VBE et déclarer la macro ainsi : "nomFeuille.nomMacro". Cependant, cela ne marche qu'avec la Feuil1 pour je ne sais quelle raison ?!? Si quelqu'un a une explication ...

A l'exécution si une animation est en cours, le lancement d'une nouvelle animation est enregistré via StartAnim et s'effectuera une fois la première terminée.
Il est a noté que même s'il est possible de limiter le 'plantage', il y a des événements qui peuvent tout de même provoquer un arrêt brutal du process sans qu'il soit possible de gérer l'exception avec On Error. Par exemple en ouvrant un nouveau classeur puis en le fermant sans sauvegarder. C'est la raison de l'ajout d'une macro de recouvrement qui permettra de réinitialiser l'animation interrompue.
La procédure StopAnim fait basculer la propriété StoppingAnim à True mais c'est dans votre boucle d'animation qu'il faut décider ou non, de Stopper l'animation en interrogeant cette propriété via AnimIsStopping. La fonction GetSystemTime avec la propriété StopTime permet d'éviter que StoppingAnim passe à True, alors que l'animation est déjà stoppée, et donc de déclencher abusivement la macro de recouvrement.
La fonction IsAnimRunning utilise la fonction GetTimeLastAskPause et permet de savoir depuis combien de temps les procédures SystemPause et WaitSpanTime ne sont plus sollicitées. Si ces dernières ne sont plus sollicitées depuis au moins 1/4 de seconde, l'animation est considérée comme stoppée.

Mise en pratique
Imaginons une application qui comporte une animation différente sur chaque onglet et c'est le basculement de feuille qui provoquera l'enchaînement vers l'animation correspondante. Elle comportera n feuilles renommer dans VBE ainsi : S_Anim{i} avec i compris entre 1 et n et la durée du cycle sera de 75 ms.
Chaque feuille, en remplaçant {i} par le numéro de feuille, comportera le code suivant :

Sub Init()
'{Initialisation de l'animation}    
End Sub

Private Sub Worksheet_Activate()
    StartAnim "RunAnimer{i}", "Init_Anim{i}"
End Sub

Private Sub Worksheet_Deactivate()
    StopAnim
End Sub

'Animation cyclique
Sub Animer()
    do
        StartTimer
        {modifier les paramètres pour ce cycle}
        WaitSpanTime 75, False    'Je déconseille de désactiver 'pauseOnCellWriting'
    Loop Until AnimIsStopping()
End Sub
'OU 
'Animation simple qui se termine d'elle même 
Sub Animer()
    {Pour chaque cycle}
        StartTimer
        {modifier les paramètres pour ce cycle}
        WaitSpanTime 75, False
    {Boucler jusqu'au dernier cycle}
End Sub

Ensuite dans un module et répéter pour chaque feuille en remplaçant {i} par le numéro de feuille :

Sub Init_Anim()
    S_Anim{i}.Init()
End Sub

Sub RunAnimer{i}()
    S_Anim{i}.Animer()
End Sub

Enfin dans le module ThisWorkbook :

Private Sub Workbook_Open()
Dim sht as Worksheet
    For each sht in ThisWorkbook.Worksheets
        sht.Init
    Next sht
End Sub

Il est possible d'ajouter la gestion des touches mais ce n'ai pas le sujet de la discussion, cependant voici 2 points :

• Application.OnKey inutile car ne peut pas déclencher la macro associée si une animation est en cours.
• Il est possible d'utiliser la fonction système GetKeyState qui fera partie d'une fonction appelée et que vous devrez insérer dans les boucles des procédures WaitSpanTime et SystemPause.

Apportez-moi vos remarques et vos astuces !

 

[Dranreb]

Bonjour.
Personnellement pour des animations j'utilise les api SetTimer et KillTimer utilisant une Sub TimerProc.
Mais Excel ne supporte pas que cette dernière le dérange à n'importe quel stade de son activité interne.
La seule manipulation de Shape ne semble cependant pas poser de problème, et MSForms, lui, y est complètement tolérant. J'ai un module de classe Rythmeur pour pouvoir utiliser dans un module objet une TimerProc d'un module standard XRythmeur qui en exécute une méthode Actionner, laquelle déclenche un évènement Intervient dans le module objet détenteur.
Tout cela est dans ce classeur avec des exemples.

 

[Lu76Fer]

Bonjour.
Personnellement pour des animations j'utilise les api SetTimer et KillTimer utilisant une Sub TimerProc.
Mais Excel ne supporte pas que cette dernière le dérange à n'importe quel stade de son activité interne.
La seule manipulation de Shape ne semble cependant pas poser de problème, et MSForms, lui, y est complètement tolérant. J'ai un module de classe Rythmeur pour pouvoir utiliser dans un module objet une TimerProc d'un module standard XRythmeur qui en exécute une méthode Actionner, laquelle déclenche un évènement Intervient dans le module objet détenteur.
Tout cela est dans ce classeur avec des exemples.

Bonsoir Dranreb,
Je viens de jeter un œil notamment sur la démo ShapeGlissant et tu utilises des objets avec de l'évènementiel ce que je ne maîtrise pas. Je vais comprendre plein de chose avec cette démo, merci encore.
Je constate que tes animations se figent dès que l'on fait une saisie dans une cellule, un peu comme dans ma solution mais le mécanisme est très différent ...
Je vais approfondir cela et merci pour ton partage !

 

[Lu76Fer]

Bonjour Dranreb,

J'ai regardé le code et j'ai vu l'intérêt des fonctions SetTimer & KillTimer qui permettent de Planifier le rythme des déclenchements de chaque animation de façon indépendante. L'avantage c'est de pouvoir déclencher une fonction d'animation par adresse au travers de SetTimer et si on voulait réaliser son propre 'Scheduler' on a pas cette possibilité sous Excel si ce n'est avec Application.Run qui n'est pas très efficace ...
Du point de vue de l'exécution je constate les mêmes inconvénients que dans ma solution (blocage lors d'une saisie au clavier) et les mêmes cas de plantage (ouvrir un nouveau classeur puis le fermer sans enregistrer provoque la fermeture brutale de ton classeur, mais pas d'Excel).
En modifiant le code je remarque que tu as choisis comme solution pour traiter les cas d'erreur d'utiliser d'ignorer les erreurs avec on resume next. De mon point de vue, je trouve que l'astuce consistant a détecter le "verrouillage d'Excel" avec la fonction IsCellWriting du module des fonctions de temporisation pourrait simplifier ton code et t'éviter ce type de pansement... Il faudrait adapter ton code en appelant cette fonction après chaque appel à OnEvents.
Bon Ap, @+​

 

[Dranreb]

Bonjour.
En soi, On Error Resume Next évite seulement un plantage. C'est plutôt de ne pas tester Err après les instructions derrière qui revient à ignorer les erreurs. Je ne vois pas trop ce que vous voulez faire.

 

[Lu76Fer]

Dans votre application, il semble effectivement que On Error soit indispensable et la création d'évènement et la gestion des mouvements est super intéressante ! J'ai essayé de rajouter ma fonction et je n'ai pas réussi à gérer ce type d'erreur, sans compter le nombre de plantage Excel.
Je n'ai pas de question au départ, c'est un simple partage de connaissance et merci encore (car ce n'est pas la première fois) de partager du code qui me sera très profitable dans la suite de mes projets ...
Pour l'instant, je préfère ne pas utiliser la fonction SetTimer et je pencherai plutôt pour réaliser mon propre Scheduler (si le besoin s'en faisait sentir) en utilisant une classe et une interface pour mes appels dynamique de fonction.
Petite spéculation personnelle : je pense que SetTimer n'est pas incompatible avec Excel mais que l'appel dynamique de fonction de façon différé et cyclique est hasardeux même si la fonction appelé fait partie d'un module. En cours de développement, on arrête souvent le programme via l'environnement de développement et c'est peut-être le fait de sauter à une adresse mémoire libéré via SetTimer qui crash Excel...
Je vais dîner de mon côté,
Une Excellente soirée !
Et @+ pour de profitables échanges ...​

 

[Dranreb]

On ne peut évidemment pas savoir pourquoi Excel se ferme brutalement lorsqu'on essaie d'utiliser une méthode de la bibliothèque Excel depuis une Sub TimerProc. On en est réduit aux conjectures. Ça me semble avoir un lointain rapport avec le fait qu'Excel refuse d'exécuter quoi que ce soit qui entrainerait la moindre modification du classeur depuis une Function invoquée par une formule, pendant une phase de calcul, donc. Par suite d'un bogue, une Sub TimerProc serait capable en s'exécutant à peu près n'importe quand du moment que l'appli ne s'est pas mise en attente d'une entrée, de contourner l'interdiction, pendant des réorganisations du classeur en tâche de fond ou quelque chose comme ça, en tout cas dans un contexte où cela ne peut avoir pour conséquence que de corrompre aussitôt la cohésion du modèle en mémoire du classeur …

 

[Lu76Fer]

Bonjour,
Petite correction sur ma procédure StartAnim dans le module d'Animation :
C'est un détail mais il faut réinitialiser les valeurs Static à la fin de la procédure :

    prvMacro = "": prvRecMac = ""
End Sub

Remarque : Il faut aussi faire attention avec les formes classiques car leur utilisation avec une boucle d'animation peu générer des erreurs.

Si on déclenche une animation à partir d'un bouton de formulaire, le bouton reste enfoncé car le déclenchement est modal et prévu pour déclencher une action simple. Du coup, la forme "verrouille" les formes pendant l'action et cela entraîne une erreur si on essaye de modifier la propriété d'une autre forme dans la boucle.​