Как создать автопрокрутку в 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. Не останавливается, когда я нажимаю клавишу
  2. Это не может быть быстрее 1 секунды. (Я мог бы использовать функцию сна, чтобы прокрутка двигалась быстрее)

Ищу некоторые рекомендации о том, как лучше всего это сделать.

Спасибо

Это кричит о проблеме XY. При этом у вашей мыши есть m-3, потому что она делает в основном это.

Warcupine 21.11.2022 21:06

@Warcupine, я пытаюсь решить это с помощью макроса. Опять же, это большой объем данных, который наносит ущерб моему запястному каналу при прокрутке с помощью клавиатуры или мыши.

Zauberflöte 21.11.2022 21:10

Нажмите среднюю кнопку мыши и немного переместите мышь вниз... это работает?

GWD 21.11.2022 21:11

Неплохое предложение @GWD, но я пытаюсь сделать это с помощью макроса, чтобы точно регулировать скорость. Спасибо

Zauberflöte 21.11.2022 21:12

@ Zauberflöte, вы пробовали ответ, который я опубликовал?

GWD 21.11.2022 23:19

Я попробую в ближайшее время и дам вам знать - большое спасибо

Zauberflöte 21.11.2022 23:54

Большое спасибо, @GWD, это то, на что я надеялся. Я немного подправил его, чтобы он начинался с текущей строки (для приостановки и возобновления), но это все. Это сложная серия циклов Do, слишком сложная для меня на данный момент. Спасибо вам за помощь. Я буду учиться на этом.

Zauberflöte 22.11.2022 05:57
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
7
65
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 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

Другие вопросы по теме