Comment faire défiler les fiches en maintenant le bouton gauche de la souris appuyé

Je tiens à remercier tout particulièrement toutes celles et tous ceux qui ont participé à la relecture de ce document en y incluant leurs remarques.

Pour tous renseignements complémentaires, veuillez me contacter directement (Argyronet) par MP.

Vous pouvez constater que ce formulaire est volontairement dépourvu du sélecteur et du diviseur d'enregistrements et de tout autre bouton lié à la fenêtre, rendant celle-ci totalement indépendante.
J'ai également pour les mêmes raisons d'esthétique d'une part et pour l'objectif de ce tutoriel en parallèle, supprimé les boutons de déplacement.

Le formulaire en mode formulaire

Lorsque l'on passe en Mode Création, vous pouvez visualiser l'ensemble des contrôles utilisés dans le formulaire. Ceux qui nous intéressent sont les contrôles « Boutons de commande » pourvus d'une flèche haut et bas de couleur bleu foncé, intercalées entre les boutons de déplacements classiques.
Pour rappel, ces boutons de déplacement utilisent une routine issue de la méthode DoCmd.GotoRecord avec les constantes acFirst, acPrevious, acNext et acLast. Pour ce tutoriel, je vais vous proposer d'utiliser également ces méthodes, mais celles-ci seront greffées de quelques lignes de code complémentaires indispensables.

Le formulaire en mode création (Design)

Pour mettre en application ce tutoriel, vous avez besoin de deux boutons que vous nommerez avec un nom circonstanciel respectif.
Dans notre exemple, ces boutons se nomment cmdPreviousMore et cmdNextMore.
Nous allons aborder au pas à pas chaque étape pour aboutir au résultat final.

Détail des éléments utilisés

Vous devez donc dessiner un bouton (sans demander à Saint Exupéry) et lui affecter une image que vous pouvez piocher dans la bibliothèque d'images ou bien une icône que vous aurez dessinée ou récupérée sur une source externe.
Pour ce faire, utilisez l'outil « Bouton » disponible dans la boîte à outils et dessinez une forme rectangulaire adaptée à votre formulaire.
Répétez l'opération pour un second bouton ou bien dupliquez celui-ci (ce qui vous assure d'avoir deux boutons identiques) puis nommez-les.

Création des boutons

Une fois les boutons nommés et alignés, vous devez leur affecter un code événement.
Mais, le code événement nécessaire au fonctionnement du défilement des fiches requiert l'initialisation de variables au moment du chargement du formulaire.
En effet, il est impératif de définir la vitesse du défilement après avoir également pris connaissance de l'état des boutons de la souris grâce aux fonctions API vues ci-après.

Vous écrirez ou recopierez donc dans la section Form_Load de votre formulaire le code suivant :

Private m_dblSpinSpeed As Double
Private m_intMouseButton As Integer

Private Sub Form_Load()
  If GetSystemMetrics(SM_SWAPBUTTON) = 1 Then
          m_intMouseButton = VK_RBUTTON
  Else
          m_intMouseButton = VK_LBUTTON
  End If
  m_dblSpinSpeed = 0.059
End Sub

Vous écrirez ou recopierez ensuite dans un module nommé « basDeclarations » s'il n'en existe pas ou bien dans un module où vous avez déjà des API's déclarées, le code suivant:

Option Explicit
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Const VK_LBUTTON As Long = &H1
Public Const VK_RBUTTON As Long = &H2
Public Const SM_SWAPBUTTON% = 23

Détail des variables utilisées

• La variable de module « m_dblSpinSpeed » est déclarée en entête de module. Elle est initialisée durant l'événement Form_Load et définie la vitesse de défilement des fiches.
  
• Les API GetSystemMetrics et GetAsyncKeyState sont déclarées en Private dans le module lui-même ou en Public si vous souhaitez exploiter cette fonctionnalité dans plusieurs formulaires différents. Elles sont dédiées respectivement à connaître périodiquement l'état des boutons de la souris pour la première et de renvoyer la valeur correspondante à l'état de permutation de ces boutons pour la seconde.
  
• Les constantes SM_SWAPBUTTON, VK_RBUTTON et VK_LBUTTON sont également déclarées avec les mêmes conditions.
  
• La variable de module m_intMouseButton est déclarée en entête de module. Elle est initialisée par l'API précitée et définit le bouton de la souris utilisé.

Vous devez donc recopier le code ci-dessous pour chaque bouton.
- Pour le bouton devant faire un défilement continu remontant, copier le code exemple cmdPreviousMore_MouseDown.
- Pour le bouton devant faire un défilement continu descendant, copier le code exemple cmdNextMore_MouseDown.

Private Sub cmdPreviousMore_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const MESSAGE_INFO As String = "Il n'y a pas de fiche précédente !"
Const MESSAGE_TITLE As String = "Parcours des fiches"

Dim sgnTickCount1 As Single
Dim sgnTickCount2 As Single
Dim sgnTickCount3 As Single
Dim intKeyState As Integer

    On Error Resume Next
    If Button = 1 Then
        sgnTickCount1 = Timer
        Do Until sgnTickCount2 > sgnTickCount1 + m_dblSpinSpeed
            sgnTickCount2 = Timer
            DoEvents
            intKeyState = GetAsyncKeyState(m_intMouseButton)
            If intKeyState = 0 Then Exit Sub
        Loop
        On Error GoTo Err_cmdPreviousMore
        DoCmd.GoToRecord , , acPrevious
L_GotoPrevious:
        Do Until sgnTickCount3 > sgnTickCount2 + m_dblSpinSpeed
            sgnTickCount3 = Timer
            DoEvents
        Loop
        intKeyState = GetAsyncKeyState(m_intMouseButton)
        If intKeyState <> 0 Then
            On Error GoTo Err_cmdPreviousMore
            DoCmd.GoToRecord , , acPrevious
            sgnTickCount2 = Timer
            DoEvents
            GoTo L_GotoPrevious
        End If
    End If
Exit_cmdPreviousMore:
    Exit Sub
Err_cmdPreviousMore:
  If Err <> 94 Then
     MsgBox MESSAGE_INFO, 64, MESSAGE_TITLE
  End If
  Resume Exit_cmdPreviousMore
End Sub

Private Sub cmdNextMore_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const MESSAGE_INFO As String = "Il n'y a pas de fiche suivante !"
Const MESSAGE_TITLE As String = "Parcours des fiches"

Dim sgnTickCount1 As Single
Dim sgnTickCount2 As Single
Dim sgnTickCount3 As Single
Dim intKeyState As Integer

    On Error Resume Next
    If Button = 1 Then
        sgnTickCount1 = Timer
        Do Until sgnTickCount2 > sgnTickCount1 + m_dblSpinSpeed
            sgnTickCount2 = Timer
            DoEvents
            intKeyState = GetAsyncKeyState(m_intMouseButton)
            If intKeyState = 0 Then Exit Sub
        Loop
        On Error GoTo Err_cmdNextMore
        DoCmd.GoToRecord , , acNext
L_GotoNext:
        Do Until sgnTickCount3 > sgnTickCount2 + m_dblSpinSpeed
            sgnTickCount3 = Timer
            DoEvents
        Loop
        intKeyState = GetAsyncKeyState(m_intMouseButton)
        If intKeyState <> 0 Then
            On Error GoTo Err_cmdNextMore
            DoCmd.GoToRecord , , acNext
            sgnTickCount2 = Timer
            DoEvents
            GoTo L_GotoNext
        End If
    End If
Exit_cmdNextMore:
    Exit Sub
Err_cmdNextMore:
  If Err <> 94 Then
      MsgBox MESSAGE_INFO, 64, MESSAGE_TITLE
  End If
  Resume Exit_cmdNextMore
End Sub

Comment ça marche ?

Les procédures de défilement continu exploitent la fonction Timer.

Cette fonction renvoie une valeur de type Single qui représente le nombre de secondes qui se sont écoulées depuis minuit dans la session Windows en cours.
L'intérêt d'user de cette fonction dans la boucle Do/Loop permet de déterminer si le nombre de secondes écoulées à partir du moment où l'utilisateur a pressé le bouton gauche de sa souris est égal à la somme des secondes additionnée à l'intervalle de temps défini par la variable m_dblSpinSpeed. Cette dernière détermine la vitesse du défilement.
Ainsi, tant que cette valeur n'est pas atteinte, on provoque un DoEvents qui sert à donner le contrôle à d'autres processus durant cet intervalle.
Bien entendu, cela est totalement transparent puisque ces intervalles se calculent en millisecondes.
Enfin, dès que la valeur attendue est atteinte, on appelle alors le DoCmd.GoToRecord pour afficher l'enregistrement Suivant ou Précédent, selon le cas.

Pour mieux comprendre l'usage de la fonction Timer, voici un petit bout de code que vous pouvez tester ;
Dans cet exemple, la fonction Timer va permettre de provoquer une pause de 8 secondes et durant cette pause, d'autres processus vont être exécutés grâce à la fonction DoEvents.

Exemple

Sub TestTimer()
Dim sgnDureePause As Single
Dim sgnDepart As Single
Dim sgnFin As Single
Dim sgnTempsTotal As Single
    
    'Définition de la durée.
    sgnDureePause = 8
    If MsgBox("Voulez-vous marquer une pause de " & Trim(Str(sgnDureePause)) & " secondes", 36, "Marquer une pause") = 6 Then
        'Définition l'heure de départ.
        sgnDepart = Timer
        Do While Timer < sgnDepart + sgnDureePause
        'Boucle de comparaison qui donne le contrôle à d'autres processus tant que la condition n'est pas vérifiée.
            DoEvents
        Loop
        'Définition l'heure de fin.
        sgnFin = Timer
        'On calcule alors la différence de temps écoulé.
        sgnTempsTotal = sgnFin - sgnDepart
        MsgBox "La pause de " & sgnTempsTotal & " secondes est maintenant terminée...", , "Fin de pause"
    End If
End Sub

C'est terminé…
Cela reste relativement simple à mettre en place compte tenu que le code est axé principalement sur les boutons.
Il vous suffit donc de passer en Mode formulaire puis de tester chacun des boutons.
L'implémentation des gestions d'erreurs permet d'afficher un message idoine dès que le premier ou le dernier enregistrement est atteint ; bien entendu, vous pouvez personnaliser ces messages qui sont stockés dans des constantes.