Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
#If Win64 Then
Private gTimerID As LongPtr, gTimerID2 As LongPtr
#Else
Private gTimerID As Long, gTimerID2 As Long
#End If
Private OrderAuto_OArgs(), OrderAuto_OIndex As Integer
Function S_OrderAuto(ByVal Target As Range, _
Optional ByVal StartNumber As Long = 1, _
Optional ByVal OverOrder As Long = 0, _
Optional ByVal Format As String = "0", _
Optional ByVal BeforeName As String = "", _
Optional ByVal AfterName As String = "") As Variant
On Error Resume Next
KillTimer 0&, gTimerID: gTimerID = 0
S_OrderAuto = BeforeName & VBA.Format(StartNumber, Format) & AfterName
If Left(CStr(S_OrderAuto), 1) = 0 Then
S_OrderAuto = "'" & S_OrderAuto
End If
Dim K As Integer
K = UBound(OrderAuto_OArgs)
ReDim Preserve OrderAuto_OArgs(1 To K + 1)
OrderAuto_OArgs(K + 1) = VBA.Array(Target, StartNumber, OverOrder, Format, BeforeName, AfterName, Application.Caller)
gTimerID = SetTimer(0&, 0&, 1, AddressOf S_OrderAuto_callback)
End Function
Private Sub S_OrderAuto_callback()
On Error Resume Next
Call KillTimer(0&, gTimerID): gTimerID = 0
Call KillTimer(0&, gTimerID2): gTimerID2 = 0
On Error GoTo 0
Dim UA As Integer
UA = UBound(OrderAuto_OArgs)
If UA > 0 Then
OrderAuto_OIndex = OrderAuto_OIndex + 1
Dim Args As Variant, A As Variant, R As Long, C As Integer, total(), UB As Long, LR As Long
Args = OrderAuto_OArgs(OrderAuto_OIndex)
UB = Args(0).Rows.Count - 1
If UB > 0 Then
ReDim total(1 To UB, 1 To 1)
LR = Args(0).Find("*", after:=Args(0)(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row - Args(0).Row + Args(2)
If LR > UB Then LR = UB
If LR > 0 Then
For R = 1 To LR
total(R, 1) = Args(4) & VBA.Format(Args(1) + R, Args(3)) & Args(5)
If Left(CStr(total(R, 1)), 1) = 0 Then
total(R, 1) = "'" & total(R, 1)
End If
Next
Args(6)(2, 1).Resize(UB).value = total
End If
End If
If OrderAuto_OIndex >= UA Then
Erase OrderAuto_OArgs: OrderAuto_OIndex = 0
Else
gTimerID = SetTimer(0&, 0&, 1, AddressOf S_OrderAuto_callback2)
End If
End If
End Sub
Private Sub S_OrderAuto_callback2()
S_OrderAuto_callback
End Sub
