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_OrderBranch(ByVal TargetBranch As Range, _
Optional ByVal TargetNames As Range, _
Optional ByVal Separator As String = ".", _
Optional ByVal Finally As Boolean = False) As Variant
On Error Resume Next
KillTimer 0&, gTimerID: gTimerID = 0
S_OrderBranch = ""
Dim K As Integer
K = UBound(OrderAuto_OArgs)
ReDim Preserve OrderAuto_OArgs(1 To K + 1)
OrderAuto_OArgs(K + 1) = VBA.Array(TargetBranch, TargetNames, Separator, Application.Caller, Finally)
gTimerID = SetTimer(0&, 0&, 1, AddressOf S_OrderBranch_callback)
End Function
Private Sub S_OrderBranch_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)
Dim R1 As Range, R2 As Range, A1 As Variant, A2 As Variant, tmp As String, K As Long
Set R1 = Args(0): Set R2 = Args(1): A1 = R1.value: A2 = R2.value
UB = R2.Rows.Count
ReDim total(1 To UB, 1 To 1)
LR = R2(Rows.Count - R2.Row, 1).End(3).Row - R2.Row + 1
If LR > UB Then LR = UB
If LR > 0 Then
tmp = A1(1, 1)
If tmp <> "" Then
For R = 2 To LR
If A1(R, 1) <> "" Then
K = 0
tmp = A1(R, 1)
Else
K = K + 1
total(R - 1, 1) = tmp & Args(2) & CStr(K)
If IsNumeric(total(R - 1, 1)) And Right(CStr(K), 1) = 0 Then
total(R - 1, 1) = "'" & total(R - 1, 1)
End If
End If
Next
Args(3)(2, 1).Resize(UB).value = total
End If
End If
If Args(4) Then Args(3).value = ""
If OrderAuto_OIndex >= UA Then
Erase OrderAuto_OArgs: OrderAuto_OIndex = 0
Else
gTimerID = SetTimer(0&, 0&, 1, AddressOf S_OrderBranch_callback2)
End If
End If
End Sub
Private Sub S_OrderBranch_callback2()
S_OrderBranch_callback
End Sub
