Discussion :

[alain16]

Bonjour,

Je cherche à faire défiler ma feuille de calcul de bas en haut ( comme un générique de film)
- de la ligne 1 à la ligne 150 (par exemple)
- et en fixant la vitesse de défilement

Avez vous une idée ?

Merci par avance et cordialement

[Nain porte koi]

Hello,

une solution

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
Sub Défilement()
 
    Range("A1").Select
 
    Dim Durée As Double
    Durée = 0.25
    ' 1 = 1 seconde
 
    Dim Fin_Pause As Double
 
    Dim i As Byte
    For i = 1 To 150
 
        ActiveWindow.SmallScroll Down:=1
 
        Fin_Pause = Timer + Durée
        Do While Timer < Fin_Pause
            DoEvents
        Loop
 
    Next i
 
End Sub

[alain16]

Hello,

une solution

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
Sub Défilement()
 
    Range("A1").Select
 
    Dim Durée As Double
    Durée = 0.25
    ' 1 = 1 seconde
 
    Dim Fin_Pause As Double
 
    Dim i As Byte
    For i = 1 To 150
 
        ActiveWindow.SmallScroll Down:=1
 
        Fin_Pause = Timer + Durée
        Do While Timer < Fin_Pause
            DoEvents
        Loop
 
    Next i
 
End Sub

Merci Nain porte koi
Cela fonctionne mais le probléme c'est que le défilement des lignes est Saccadé
Lorsque j'utilise la fonction défilement manuel d'Excel , Le défilement est fluide et non pas saccadé
Une autre splution ?
Cordialement

[jurassic pork]

mais le probléme c'est que le défilement des lignes est Saccadé
Lorsque j'utilise la fonction défilement manuel d'Excel , Le défilement est fluide et non pas saccadé

Hello,
Normalement, on ne peut scroller en vertical que ligne par ligne pas pixel par pixel.
Il y a bien le mode Autoscroll que l'on active par clic sur le bouton milieu de la souris, et on déplace alors la souris vers le bas pour amorcer le scroll (plus on s'éloigne du point initial , plus c'est rapide) :

En VBA on peut simuler le clic milieu de la souris à partir d'une cellule et ensuite positionner le curseur en dessous. On arrête ce mode en recliquant sur le bouton milieu de la souris. Mais le problème c'est qu'apparemment dès qu'on est en auto-scroll le VBA ne s'exécute plus donc pas moyen de contrôler l'arrêt. En plus si on bouge la souris pendant l'autoscroll cela peut faire n'importe quoi.
voici quand même le code pour amorcer le scroll fluide à partir de la cellule A1 :

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
Option Explicit
' API for simulating mouse input
Private Declare PtrSafe Sub mouse_event Lib "user32" ( _
    ByVal dwFlags As Long, _
    ByVal dx As Long, _
    ByVal dy As Long, _
    ByVal dwData As Long, _
    ByVal dwExtraInfo As LongPtr)
 
 
Private Declare PtrSafe Function SetCursorPos Lib "user32" ( _
    ByVal X As Long, ByVal Y As Long) As Long
 
 
Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
    lpPoint As POINTAPI) As Long
 
 
' Mouse event constants
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
 
 
' Structures
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
 
' === MAIN ===
Sub SimulateMiddleClickOnA1()
    Dim rng As Range
    Dim origPos As POINTAPI
    Dim cellX As Long, cellY As Long
 
    ' Target cell
    Set rng = ActiveSheet.Range("A1")
 
    ' Make sure cell is visible
    Application.Goto rng, True
 
    ' Convert cell position to screen coordinates
    cellX = ActiveWindow.PointsToScreenPixelsX(rng.Left + rng.Width / 2)
    cellY = ActiveWindow.PointsToScreenPixelsY(rng.Top + rng.Height / 2)
 
    ' Amener le curseur en A1
    SetCursorPos cellX, cellY
 
    ' Clic bouton milieu souris
    mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
 
    ' Déplacer curseur
    SetCursorPos cellX, cellY + 25  ' Déplacement du curseur de 25 pixels vers le bas 
End Sub
 
 
Sub TestSmoothScroll()
   SimulateMiddleClickOnA1
End Sub

Comment tester par exemple la ligne qui se trouve en haut de la feuille (par scrollrow) pendant le déplacement et simuler un clic milieu souris quand on atteint une certaine ligne ?
Comment empêcher la souris de se déplacer pendant le défilement ?

Ami calmant, J.P

[alain16]

Merci jurassic pork

Cela fonctionne trés bien et ça correspond à ce que je voulais.

.... Merci aussi (et c'est important) d'avoir pris le temps de rajouter des explications à chaques ligne de code.

Cela facilite,bien sûr, la compréhension, mais ça permet aussi de pouvoir adapter ensuite plus facilement le code à nos besoins pour les personnes qui n'ont pas le même niveau en VBA.

Cordialement

[Nain porte koi]

Merci Nain porte koi
Cela fonctionne mais le probléme c'est que le défilement des lignes est Saccadé
Lorsque j'utilise la fonction défilement manuel d'Excel , Le défilement est fluide et non pas saccadé
Une autre splution ?
Cordialement

Ce qui fait que ça "saccade" c'est la pause entre les SmallScroll Down:1 (ça descend d'une ligne à chaque boucle), si on l'enlève ou la réduit fortement on ne verra plus le "saccadage" :-) mais pour lire faudra faire vite

La solution de jurassic pork (Hello) à le mérite d'exister, mais comme il l'a dit lui même, il ne faut pas bouger la souris (ou seulement en vertical pour accélère ou ralentir) et le défilement est infini.

Je ne sais pas ce que vous voulez faire exactement, mais un logiciel de montage vidéo vous fera des trucs plus mieux bien meilleur pour beaucoup moins de complication. Pour mémoire, Excel est un... tableur
Selon Wiki : Un tableur est un programme informatique capable de manipuler des feuilles de calcul...

[laurent_ott]

Bonjour,
J'ai trouvé l'exercice intéressant, même si je n'en vois pas l'utilité.

Sur une feuille de calcul j'ai mis les valeurs 1 à 50 en colonne "A" de la ligne 1 à 50.
Le but est de faire défiler la feuille, sans saccade, en simulant un déplacement sur la barre verticale, et quand la valeur 40 (par exemple) apparait, alors je place la curseur dessus et la sélectionne.

Notes :
- la fonction "PositionBarreVerticale" cherche l'emplacement de la barre verticale (pas facile à trouver, vous ajusterez à votre configuration si besoin) ;
- quand c'est bon on peut lancer la fonction "ExempleDéfilementVertical" ;
- si la feuille est sur l'écran principal on peut tester la couleur du pixel pointé par la souris et vérifier que c'est la couleur de la barre pointée. Sinon il faut s'en assurer visuellement.

Code VBA :

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
Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private lPt As POINTAPI
 
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal dwData As Long, ByVal dwExtraInfo As LongPtr)
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
 
Const MOUSEEVENTF_LEFTDOWN As Long = &H2
Const MOUSEEVENTF_LEFTUP As Long = &H4
Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Const MOUSEEVENTF_RIGHTUP As Long = &H10
Const MOUSE_MOVE = &H1
 
'------------------------------------------------------------------------------------------------
Sub PositionBarreVerticale()
'------------------------------------------------------------------------------------------------
' Affiche les barres:
Application.DisplayScrollBars = True
 
' Remet la barre verticale en haut:
Application.Goto [A1], True
 
' Cherche la position de la barre (à vérifier sur votre configuration et version d'Excel):
lPt.x = PointsEnPixelsX(Application.Left + Application.Width - 10)
lPt.y = PointsEnPixelsY(Application.Top + 150)
 
' Se place à cette position
SetCursorPos lPt.x, lPt.y
 
' Si Ce point est de couleur 15660521 (Excel 2016) c'est que c'est bon, on peut lancer le traitement.
' Attention : valable uniquement sur l'écran principal. Pour un second écran lancez directement
' la fonction ExempleDéfilementVertical si la position est bonne:
Dim T
T = Timer: While T + 1 > Timer: DoEvents: Wend
If GetPixel(GetWindowDC(0), lPt.x, lPt.y) = 15660521 Then
    Call ExempleDéfilementVertical
Else
    If MsgBox("Est-ce que la souris est bien sur la barre verticale ?", vbYesNo) = vbYes Then
        T = Timer: While T + 1 > Timer: DoEvents: Wend
        Call ExempleDéfilementVertical
    End If
End If
End Sub
 
'------------------------------------------------------------------------------------------------
Private Sub ExempleDéfilementVertical()
'------------------------------------------------------------------------------------------------
Dim i As Long, y As Long
 
' Pointe en début de liste:
Application.Goto [A1], True
 
' Boucle la barre verticale, la descend de 2 pixels à chaque passage:
For i = 1 To 300
    ' Place la souris sur la barre (voir la fonction PositionBarreVerticale),
    ' utile aussi si l'utilisateur l'a déplacé:
    lPt.y = lPt.y + 2
    SetCursorPos lPt.x, lPt.y
    ' Intervention souris:
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0  ' Clic gauche souris.
    mouse_event MOUSE_MOVE, 0, 2, 0, 0            ' Déplacement de 2 vers le bas.
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0    ' Relâche la souris.
    DoEvents
    Sleep 10
    ' Sort si parmi les lignes visibles une des cellules en "A" vaut 40:
    For y = ActiveWindow.VisibleRange.Row To ActiveWindow.VisibleRange.Row + ActiveWindow.VisibleRange.Rows.Count - 5
        If Cells(y, "A") = 40 Then
            ' Déplace la sélection sur cette cellule:
            i = ActiveWindow.VisibleRange.Row
            While i <> y
                Cells(i, "A").Select
                Sleep 100
                i = i + 1
            Wend
            Cells(y, "A").Select
            Exit Sub
        End If
    Next y
Next i
 
End Sub
 
'------------------------------------------------------------------------------------------------
Public Function PointsEnPixelsX(lPoint As Long) As Long
'------------------------------------------------------------------------------------------------
Static Mult As Single
If Mult = 0 Then Mult = 72 / GetDeviceCaps(GetWindowDC(0), 88) ' LOGPIXELSX
PointsEnPixelsX = CLng(lPoint / Mult)
End Function
 
'------------------------------------------------------------------------------------------------
Public Function PointsEnPixelsY(lPoint As Long) As Long
'------------------------------------------------------------------------------------------------
Static Mult As Single
If Mult = 0 Then Mult = 72 / GetDeviceCaps(GetWindowDC(0), 90) ' LOGPIXELSY
PointsEnPixelsY = CLng(lPoint / Mult)
End Function
 
'------------------------------------------------------------------------------------------------
Sub Test_Couleur_Barre_Verticale()
'------------------------------------------------------------------------------------------------
' Fonction pour connaitre la couleur de la barre verticale quand elle est pointée.
' Se positionner dessus et lancer cette fonction avec F5 manuellement.
'------------------------------------------------------------------------------------------------
GetCursorPos lPt
Debug.Print GetPixel(GetWindowDC(0), lPt.x, lPt.y)
End Sub
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------

Bonne programmation.

[Nain porte koi]

Hello laurent_ott

amusant
Mais bon, là encore faut pas bouger la souris (j'ai fais défiler le code )

[tototiti2008]

Bonjour,

Pour info, le générique de Nain (que je salue) se bloque à minuit

Timer
Renvoie une valeur de type Single qui représente le nombre de secondes écoulées depuis minuit.

Edit : C'est comme les Mogwai, ne pas lancer le générique juste avant minuit

[Nain porte koi]

Ah me***
Bon, reste encore quelques minutes, ça devrait suffire pour aller jusqu'à la ligne 150