Как создать автопрокрутку в Excel VBA, которая приостанавливается при нажатии любой клавиши?
У меня есть большой объем данных для прокрутки каждый день, и макрос автопрокрутки, который приостанавливается при нажатии клавиши (и возобновляется нажатием кнопки), был бы большим подспорьем.
До сих пор я пробовал:
Sub Autoscroll()
Dim RowCount As Integer
Dim i As Integer
RowCount = Range("Table").Rows.Count
For i = RowCount + 1 To 2 Step -1
Range("A" & i).Select
Application.Wait (Now + TimeValue("0:00:01"))
Next i
End Sub
Но это не достигает того, что я хочу по нескольким причинам:
- Не останавливается, когда я нажимаю клавишу
- Это не может быть быстрее 1 секунды. (Я мог бы использовать функцию сна, чтобы прокрутка двигалась быстрее)
Ищу некоторые рекомендации о том, как лучше всего это сделать.
Спасибо
@Warcupine, я пытаюсь решить это с помощью макроса. Опять же, это большой объем данных, который наносит ущерб моему запястному каналу при прокрутке с помощью клавиатуры или мыши.
Нажмите среднюю кнопку мыши и немного переместите мышь вниз... это работает?
Неплохое предложение @GWD, но я пытаюсь сделать это с помощью макроса, чтобы точно регулировать скорость. Спасибо
@ Zauberflöte, вы пробовали ответ, который я опубликовал?
Я попробую в ближайшее время и дам вам знать - большое спасибо
Большое спасибо, @GWD, это то, на что я надеялся. Я немного подправил его, чтобы он начинался с текущей строки (для приостановки и возобновления), но это все. Это сложная серия циклов Do, слишком сложная для меня на данный момент. Спасибо вам за помощь. Я буду учиться на этом.
Ответы 1
Если вы настаиваете на использовании макроса, попробуйте это, он должен помочь (если вы используете Windows!).
Вы должны нажать клавишу возврата, чтобы прервать. Если вы предпочитаете другой ключ, дайте мне знать.
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If
'Sub pausing code execution without freezing the app or causing high CPU usage
'Author: Guido Witt-Dörring, https://stackoverflow.com/a/74387976/12287457
Public Sub WaitSeconds(ByVal seconds As Single)
Const VK_RETURN = &HD
Dim currTime As Single, endTime As Single, cacheTime As Single
currTime = Timer(): endTime = currTime + seconds: cacheTime = currTime
Do While currTime < endTime
If GetAsyncKeyState(VK_RETURN) Then
Sleep 200
Do Until GetAsyncKeyState(VK_RETURN)
DoEvents: Sleep 15
Loop
Sleep 200
End If
DoEvents: Sleep 15: currTime = Timer()
'The following is necessary because the Timer() function resets at 00:00
If currTime < cacheTime Then endTime = endTime - 86400! 'seconds per day
cacheTime = currTime
Loop
End Sub
Sub Autoscroll()
Dim RowCount As Long
Dim i As Long
RowCount = Range("Table").Rows.Count
For i = RowCount + 1 To 2 Step -1
WaitSeconds 0.5 '<-- this is how long it waits at every row,
Range("A" & i).Select 'set it to your desired value
Next i
End Sub
Это кричит о проблеме XY. При этом у вашей мыши есть m-3, потому что она делает в основном это.