Как я могу регулировать функции в VBA?

Question

Я делаю выпадающий внутри Excel, используя ComboBox и VBA. Мне удалось заставить его отправлять запросы к удаленному API, добавлять возвращенные данные в скрытый лист и обновлять параметры раскрывающегося списка в зависимости от результата API.

То, что я хочу сделать, это задушить запросы API. На данный момент кажется, что Excel не будет запускать сабвуфер, если он уже обрабатывает API-запрос. Это не идеально, потому что часто люди набирают более одного символа в быстрой последовательности. Я хотел бы добавить таймер для каждого дополнительного вызова, и если в течение ~ 250 мс не было нового вызова для вспомогательной функции, отправьте запрос API. Если в течение 250 мс будет сделан другой вызов, я хочу отменить выполнение этого саба.

Первоначально я попытался создать глобальный «process_id», в котором подпрограмма добавила бы 1 к текущему глобальному, установила бы свой локальный идентификатор на это значение, подождала x раз, проверила, является ли его локальный идентификатор === глобальным идентификатором, и если не выход саб. Однако теперь кажется, что вторая подпрограмма никогда не запускается, пока таймер ожидает x времени, поэтому первая подпрограмма все еще запускается, всего через x секунд (а вторая подпрограмма вообще никогда не запускается).

Как мне выполнить регулирование подфункций в Excel VBA, чтобы одна и та же подфункция могла быть запущена, пока первая ожидает?

Answer 1

Как указано; вам нужен асинхронный таймер с точностью до миллисекунды

Надеюсь, у вас должно получиться следующее:

Когда таймер установлен, дальнейший таймер устанавливать не следует, и когда таймер запускает событие, таймер останавливается, поэтому множественные вызовы в течение периода 'DelayTimeSeconds' должны приводить только к одному вызову API

' Adapted from https://groups.google.com/forum/?hl=en#!topic/microsoft.public.excel.programming/Ce--7sympZM
' These procedures require that you are using Office 2000 or later, because of the AddressOf function

Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Private AllowFireTime As Single
Private TimerID As Long
Private TimerSeconds As Single
Private TimerSet As Boolean

Const DelayTimeSeconds As Single = 0.75

Sub TestFireDelay()
    CallAPIProc
End Sub

Private Function CallAPIProc()
    Dim NowTime As Single: NowTime = Timer
    If AllowFireTime > NowTime Then
        If TimerSet = False Then StartTimer AllowFireTime - NowTime
    Else
        AllowFireTime = NowTime + DelayTimeSeconds

        Call TestCall
        ' Code for API Call

    End If
End Function

Function StartTimer(Optional TimerSeconds = 1) ' how often to "pop" the timer.
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
    TimerSet = True
End Function

Function EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
    TimerSet = False
End Function

Function TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    ' The procedure is called by Windows. Put your timer-related code here.
    '
    Call EndTimer
    Call CallAPIProc
End Function

Function TestCall()
    Debug.Print Format(Now, "hh:mm:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function

Answer 2

I думаю , что вы действительно ищете, это «не вызывать API, пока я не перестал печатать» (т. Е. Если в течение x мс не было нажатий клавиш) .

Если это то, что вы хотите, то это (с подсказкой к ответу @ Tragamor) должно сделать это. Это намного ближе к тому, что вы могли бы сделать в js, например, используя window.setTimeout.

В обычном кодовом модуле:

Option Explicit

Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Private TimerID As Long

'this function called from the control's Change event
Function CallApi()
    Const DelayMsec As Long = 500
    If TimerID > 0 Then KillTimer 0&, TimerID 'kill any existing timer
    TimerID = SetTimer(0&, 0&, DelayMsec, AddressOf CallApi2) 'set a timer
End Function

'this function called from the timer
Sub CallApi2()
    If TimerID > 0 Then KillTimer 0&, TimerID
    Debug.Print "Calling API with '" & Sheet1.TextBox1.Text & "'"
End Sub

Answer 3

Придерживаясь метода использования глобальных переменных, сохраняйте единицу, чтобы отслеживать функцию Timer. К сожалению, вы не предоставили свой код, поэтому я могу только предположить, как вам следует это реализовать.

Private myTimer As Single   '// Global Variable, outside of any routine

Sub foo()               

    If Timer - myTimer < 0.25 Then Exit Sub

    callMyAPI
    myTimer = Timer

End Sub

Если вы предпочитаете не выходить из подпрограммы, оберните вызов API в оператор If.

Private myTimer As Single

Sub foo()

    ' Non-API related code

    If Timer - myTimer > 0.25 Then
        callMyAPI
        myTimer = Timer
    End If

    'Non-API related code

End Sub

При каждом вызове API вы будете сбрасывать переменную myTimer.