Commençons par: Pourquoi n'y a t-il pas d'évènement Scrolling généré par Excel pour les fenêtres de classeurs?

D'après ce que je comprends:
Les fenêtres étant des objets systèmes, les évènements ascenseurs des fenêtres sont traités entre l'application et le système.

Dans le cas de la plupart des fenêtres principales d'applications, une possibilité de donner ce droit de gestion à l'utilisateur n'est pas supporté.

Imaginez une application qui passe la main à un thread qu'il ne contrôle pas, dans un processus dont le traitement devrait être le plus bref possible pour rendre rapidement la main au chef d'orchestre (système).

Sans aller trop dans le fond, exclure le risque d'une action compromettante dans les requêtes et réponses réciproques entre le système et l'application est un choix privilégié.

Parfois, l'utilisateur que nous sommes avons besoin d'être informés sur le changement d'état provoqué par la barre de défilement. Ce fut mon cas dans ce message: http://www.developpez.net/forums/d13...-dans-fenetre/.

J'avais cru avoir eu la solution idéale en excluant l'affichage des barres de défilement en y mettant à leurs places des contrôles ascenseurs.
Eh bien grande fut ma déception!
_Primo: ces contrôles ne sont pas du tout ergonomiques.
_Secundo, la mise à jour de leurs positions dans la zone client n'est jamais parfaite ou implique de nombreuses acrobaties, surtout quand vous avez des lignes ou des colonnes de dimensions différentes.
_Tertio: avec plusieurs fenêtres enfants d'une même fenêtre, ces contrôles sont tout simplement hors circuit.

Je me suis rabattu rapidement sur mon choix précédent.


Le code que je propose ici est une adaptation perfectible du besoin que j'avais, pour générer de façon asynchrone un évènement Scrolling.
(Personnellement je ne vois pas encore l'utilité d'un évènement Scrolling.)
L'exemple est à but démonstratif pouvant servir d'inspiration pour ceux qui auraient un problème en rapport avec la gestion de l'affichage et même plus.

Créer un nouvel projet dans lequel vous ajouterez un module de classe, un module standard, un userform.

Le code suivant est à coller dans un module de classe nommé: Zones_State.
Elle est dotée de quelques propriétés et methodes pouvant être lues partout au sein de votre projet.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
 
Option Explicit
 
Private Type Valeur
     Gauche As Double
     EnTete As Double
     Hauteur As Double
     Largeur As Double
     Ligne As Long
     Colonne As Long
End Type
 
Private Type StateCadre
     Adresse_Cadre As String
     old_Adresse_Cadre As String
     Cadre_Change As Boolean
     NumCadre As Integer
     Valeurs_Courante As Valeur
     Valeurs_Precedente As Valeur
End Type
 
Private Type Fenetre
     ActifVue As Integer
     Nom As String
     Cadre() As StateCadre
     Activ As Boolean
     Index As Integer
     Rect As Variant
End Type
 
Public Enum DUREE
     Non
     Insuffisant
     Assez_suffisant
     Suffisant
     Beaucoup_suffisant
End Enum
 
Public Enum Deplacement
     En_place
     Bas
     Haut
     Droite
     Gauche
End Enum
 
Public Collectionner As Boolean
 
Event FCadreChange(ByVal window_name As String, ByVal index_pane As Integer, adresse_plage As String)
Event IsMoved(ByVal scroll As Long, Mouvement As String)
 
Const In_ As String = "En place", Down As String = "Bas", Up As String = "Haut", Right As String = "Droite", Left As String = "Gauche"
 
 
Dim Annuler As Boolean
Dim Fenetres() As Fenetre
Dim f_num As Integer, v_num As Integer, last_v_num As Integer, change As Long, change_Nom As String
Dim f_id As String, f_old_Id As String, f_Vue As String, f_old_Vue As String
Dim Temps_Dif As Single
 
Friend Property Get Deplacer() As Deplacement
 
     Dim cr As StateCadre, l1 As Long, l2 As Long, c1 As Long, c2 As Long
 
     cr = Fenetres(f_num).Cadre(v_num)
     l1 = cr.Valeurs_Courante.Ligne
     l2 = cr.Valeurs_Precedente.Ligne
     c1 = cr.Valeurs_Courante.Colonne
     c2 = cr.Valeurs_Precedente.Colonne
     c2 = cr.Valeurs_Precedente.Colonne
 
     Deplacer = Switch(l1 > l2, 1, _
               l1 < l2, 2, _
               c1 > c2, 3, _
               c1 < c2, 4, _
               l1 = l2 Or c1 = c2, 0)
 
End Property
 
Friend Property Get Deplacement_Value() As Long
 
     Dim i As Integer
     Dim cr As StateCadre, l1 As Long, l2 As Long, c1 As Long, c2 As Long
 
     cr = Fenetres(f_num).Cadre(v_num)
     l1 = cr.Valeurs_Courante.Ligne
     l2 = cr.Valeurs_Precedente.Ligne
     c1 = cr.Valeurs_Courante.Colonne
     c2 = cr.Valeurs_Precedente.Colonne
     c2 = cr.Valeurs_Precedente.Colonne
 
 
     i = Deplacer
     change = Switch(i = Bas, l1 - l2, _
               i = Haut, l1 - l2, _
               i = Droite, c1 - c2, _
               i = Gauche, c1 - c2, _
               i = En_place, 0)
 
     Deplacement_Value = change
 
End Property
 
Friend Property Get Deplacement_Name() As String
 
     Dim i As Deplacement
 
     i = Deplacer
 
     change_Nom = Switch(i = Bas, Down, _
               i = Haut, Up, _
               i = Droite, Right, _
               i = Gauche, Left, _
               i = En_place, In_)
 
     Deplacement_Name = change_Nom
 
End Property
 
Friend Property Get Appreciation_duree() As DUREE
 
     Appreciation_duree = Time_duree(Temps_Dif)
 
End Property
 
Static Function Getting(Optional Interne As Integer) As Boolean
 
     Dim fn() As Fenetre, f As Integer, v As Integer, i As Integer
     Dim timeZ As String, timeX As Single, timeY As Single, timeDif As Single
 
     f_num = f: v_num = v: Fenetres = fn
 
     On Error Resume Next
     i = UBound(Fenetres)
     If i = 0 Then Err.Clear
     On Error GoTo 0
 
     If i < Windows.Count Then
 
          timeX = Timer
          GoSub init_Var
 
     Else
 
          If UBound(Fenetres) > Windows.Count _
          Or UBound(Fenetres) < Windows.Count Then
 
               GoSub init_Var
 
          Else
 
               For i = 1 To UBound(Fenetres)
 
                    If UBound(Fenetres(i).Cadre) < Windows(Fenetres(i).Nom).Panes.Count _
                    Or UBound(Fenetres(i).Cadre) > Windows(Fenetres(i).Nom).Panes.Count Then
 
                         GoSub init_Var
 
                    End If
 
               Next
 
          End If
 
          Statements Fenetres, timeZ, timeX, timeY, timeDif
 
     End If
 
 
 
     f_old_Id = f_id
     f_old_Vue = f_Vue
     last_v_num = v_num
     v = v_num
     f = f_num
     fn = Fenetres
     Getting = True
     Exit Function
 
init_Var:
 
     f_Vue = "": f_old_Id = "": f_old_Vue = ""
     f_id = 0: v_num = 0: f_num = 0: v = 0: f = 0: last_v_num = 0
     Initialise Fenetres, timeX, timeY, timeDif
     f_old_Vue = f_Vue: f_old_Id = f_id: last_v_num = v_num
 
Return
 
End Function
 
Private Sub Statements(Fenetres() As Fenetre, _
      timeZ As String, timeX As Single, timeY As Single, timeDif As Single)
 
     Dim r As Range, i As Integer
     Dim wn As Window, wName As String
 
     Set wn = ActiveWindow
 
     If wn.Caption <> Fenetres(f_num).Nom Then
 
          Fenetres(f_num).Activ = False
          wName = wn.Caption
 
          For i = 1 To UBound(Fenetres)
               If Fenetres(f_num).Nom = wName Then f_num = i
          Next
 
          Fenetres(f_num).Activ = True
 
     End If
 
     last_v_num = Fenetres(f_num).ActifVue
     v_num = wn.ActivePane.Index
     Fenetres(f_num).ActifVue = v_num
     Actualise_Fen wn, Fenetres(f_num), timeX, timeY, timeDif, v_num
 
     f_id = Fenetres(f_num).Nom & "_" & wn.ActiveSheet.Name
     Get_Event 1
 
End Sub
 
Private Sub Initialise(Fenetres() As Fenetre, timeX As Single, timeY As Single, timeDif As Single)
 
     Dim r As Range, i As Integer
     Dim wn As Window, wName As String
 
     ReDim Fenetres(1 To Windows.Count)
     f_id = ActiveWindow.Caption
     timeX = Timer
 
     For Each wn In Windows
          i = i + 1
          ReDim Preserve Fenetres(i).Cadre(1 To wn.Panes.Count)
 
          With Fenetres(i)
               .Nom = wn.Caption
               .Index = i
               .Activ = .Nom = ActiveWindow.Caption
               .ActifVue = wn.ActivePane.Index
          End With
 
          Actualise_Fen wn, Fenetres(i), timeX, timeY, timeDif
 
          If Fenetres(i).Activ Then
               f_num = i
               v_num = wn.ActivePane.Index
               f_id = Fenetres(i).Nom
               f_Vue = Fenetres(i).Cadre(v_num).Adresse_Cadre
               Actualise_Fen wn, Fenetres(i), timeX, timeY, timeDif, v_num
          End If
     Next
 
End Sub
 
Private Sub Actualise_Fen(w As Window, fn As Fenetre, timeX As Single, timeY As Single, timeDif As Single, Optional vue_Cible As Integer = 0)
 
     Dim i As Integer, r As Range
 
     For i = 1 To w.Panes.Count
 
          If vue_Cible Then
 
               Set r = w.Panes(i).VisibleRange
 
               With fn.Cadre(i)
                    .Cadre_Change = .Adresse_Cadre <> r.Address
                    If .Cadre_Change Then
                         .old_Adresse_Cadre = .Adresse_Cadre
                         .Adresse_Cadre = r.Address
                         .Valeurs_Precedente = .Valeurs_Courante
                         With .Valeurs_Courante
                              .Colonne = r.Column
                              .Ligne = r.Row
                              .EnTete = r.Top
                              .Gauche = r.Left
                              .Hauteur = r.Height
                              .Largeur = r.Width
                         End With
                         timeY = Timer
                         timeX = timeY
                         timeDif = Timer - timeX
                         v_num = i
                         f_Vue = .Adresse_Cadre
                    Else
                         timeDif = Timer - timeX
                         .Valeurs_Precedente = .Valeurs_Courante
                    End If
               End With
 
          Else
               Set r = w.Panes(i).VisibleRange
               With fn.Cadre(i)
                    .Adresse_Cadre = r.Address
                    .old_Adresse_Cadre = .Adresse_Cadre
                    .NumCadre = i
                    With .Valeurs_Courante
                         .Colonne = r.Column
                         .Ligne = r.Row
                         .EnTete = r.Top
                         .Gauche = r.Left
                         .Hauteur = r.Height
                         .Largeur = r.Width
                    End With
                    .Valeurs_Precedente = .Valeurs_Courante
               End With
 
          End If
     Next
 
End Sub
 
Private Function Time_duree(timeDif As Single) As DUREE
 
     Select Case timeDif
          Case Is <= 5
               Time_duree = Non
          Case 5 To 10
               Time_duree = Insuffisant
          Case 10 To 20
               Time_duree = Assez_suffisant
          Case 20 To 30
               Time_duree = Suffisant
          Case Is > 30
               Time_duree = Beaucoup_suffisant
     End Select
 
End Function
 
Sub Get_Event(id_event As Integer)
 
     Dim sc As Long, m As String
 
     Annuler = False
     sc = Deplacement_Value
     m = Deplacement_Name
 
     If f_old_Id <> f_id Or last_v_num <> v_num Then
 
          RaiseEvent FCadreChange(Mid(f_id, 1, InStr(1, f_id, "_") - 1), v_num, f_Vue)
          'RaiseEvent IsMoved(sc, m)
          If f_Vue <> f_old_Vue Then RaiseEvent IsMoved(sc, m)
 
     ElseIf f_Vue <> f_old_Vue Then
 
          RaiseEvent IsMoved(sc, m)
 
     End If
 
End Sub
Le code suivant est destiné au module standard. C'est le moteur de notre programme. Il peut être appelé n'importe où dans le projet.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Explicit
Option Private Module
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Auto_Collect As Boolean
 
Dim Requis As Boolean, isRun As Boolean, zones As Zones_State
 
Sub Requetes(Optional zn As Zones_State)
 
    If zn Is Nothing Then
 
        If zones Is Nothing Then
            Set zn = New Zones_State
        Else
            Set zn = zones
        End If
 
    End If
 
    If Requis = False Then
 
        Requis = zn.Getting
        Set zones = zn
        If Requis = False Then Exit Sub
 
        If Auto_Collect And isRun = False Then
            Application.OnTime Time + 0.00001, "Requetes", Time + 0.00015
            Exit Sub
        End If
 
    Else
 
        If isRun Then
            'MsgBox "Une requête est déjà en cours d'éxécution. " _
            & Chr(10) & "Vous devez l'arrêter avant un nouvel rappel.", vbCritical, "Requetes"
            Exit Sub
        End If
 
    End If
 
    isRun = True 'il est vital d'avoir une parade pour ne pas entrer, par un autre appel dans la boucle déjà en éxécution
 
    While Auto_Collect
 
        Sleep 10
        DoEvents
        Requis = zn.Getting
 
     Wend
 
     Requis = False
     isRun = False
     Set zones = zn
 
End Sub
Le code suivant est destiné à la classe UserForm.
Vous devez y ajouter 3 contrôles: 2 Labels nommés "Lab1" et "Lab2" et un CheckBox nommé "ActiverGet".
Mettez la propriété ShowModal de l'userform à False.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
Private WithEvents zone As Zones_State
 
 
Private Sub ActiverGet_Click()
 
     Auto_Collect = ActiverGet.Value
     If Auto_Collect Then Requetes zone
 
End Sub
 
Private Sub UserForm_Initialize()
 
     Set zone = New Zones_State
     Auto_Collect = ActiverGet.Value
     Requetes zone
 
End Sub
 
Private Sub UserForm_Terminate()
 
     Auto_Collect = False
 
End Sub
 
Private Sub zone_FCadreChange(ByVal window_name As String, ByVal index_pane As Integer, adresse_plage As String)
 
     Dim i As String, dep As String
 
     dep = zone.Deplacement_Name
     i = "Le volet n° " & index_pane & " est actif. La vue est " & dep
 
     If Windows(window_name).Panes.Count = 4 Then
 
          If dep = "Bas" Or dep = "Haut" Then
               i = "Les vues des volets " & index_pane - 1 & " & " & index_pane & " ont changé."
          ElseIf dep = "Droite" Or dep = "Gauche" Then
               i = "Les vues des volets " & index_pane - 2 & " & " & index_pane & " ont changé."
          End If
 
     End If
 
     Lab1.Caption = i
     Lab2.Caption = dep & ". Le scrolling est de " & zone.Deplacement_Value
     Me.Caption = window_name & " est actif. Dernière vue affichée: " & adresse_plage
 
End Sub
 
Private Sub zone_IsMoved(ByVal scroll As Long, Mouvement As String)
 
     Lab2.Caption = "Le décalage est " & Mouvement & ". Le scrolling est de " & scroll
 
End Sub
Exécution de l'Userform.
La boucle "sans fin" dans le Sub "Requetes" est branché sur un booléen public pouvant être affecté n'importe quand, ailleurs dans votre projet pour mettre fin à la procédure. la consommation du processeur est également pris en compte.

Un classeur exemple info vue.7z

d'autres idées d'améliorations sont bienvenues.

Merci d'avoir lu.