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 |
Partager