У меня есть процедура, которая генерирует отчеты на основе пользовательского ввода, предоставленного в форме пользователя.Я реализовал обработку ошибок, как и должно быть, но один из моих обработчиков ошибок не очень хорошо работает с DoEvents.Проблема в том, что моя основная подпрограмма LoopGenrtReport, которая зацикливает другую подпрограмму GenerateReport, зависает на разную длительность, ЕСЛИ подпрограмма GenerateReport закрыта из-за ошибки.Я говорю различной длины, потому что иногда это 5 секунд, а в других случаях он никогда не переходит к следующей итерации цикла.
Я протестировал удаление кода для индикатора выполнения и Doevents, и при этом я обнаружил, что процедура работает точно так, как задумано.
Я также тестировал без Application.Interactive, но С индикатором выполнения и Doevents, чтобы увидеть, может ли это быть проблемой, но происходит то же самое.
Ниже приведен код:
Private Sub LoopGenrtReport(ByRef InPut_Array As Variant)
Dim ii As Long
Dim UBTailNum_Array As Long
Dim Filtered_Array As Variant
Dim LoopCounter As Long
Dim pctdone As Single
Application.ScreenUpdating = False
Application.Interactive = False
UBTailNum_Array = UBound(InPut_Array)
'Sheet_Array is a public variable as are StartDate and End Date
Filtered_Array = SubsetArray(Sheet_Array, StartDate, EndDate)
If IsEmpty(Filtered_Array) Then
MsgBox "No Transactions were found in the date range selected.", _
vbCritical, "Error: No Transactions Found"
GoTo ClearVariables
End If
'Release from memory
Erase Sheet_Array
'Show progress bar if more than one report _
is being generated
If UBTailNum_Array > 0 Then Call ShowPrgssBar
For ii = LBound(InPut_Array) To UBound(InPut_Array)
LoopCounter = LoopCounter + 1
pctdone = LoopCounter / (UBTailNum_Array + 1)
With FrmProgress
.LabelCaption.Caption = "Generating Report(s) " & LoopCounter & " of " & UBTailNum_Array + 1
.LabelProgress.Width = pctdone * (.FrameProgress.Width)
End With
DoEvents
Call GenerateReport(Filtered_Array, CStr(InPut_Array(ii)))
Next ii
ClearVariables:
StartDate = Empty
EndDate = Empty
ii = Empty
InPut_Array = Empty
UBTailNum_Array = Empty
Filtered_Array = Empty
LoopCounter = Empty
pctdone = Empty
Application.Interactive = True
Application.ScreenUpdating = True
End Sub
Примечание: Это происходит ТОЛЬКО при выходе из GenerateReport из-за ошибки.Фактическая ошибка заключается в том, что для текущего элемента InPut_Array(ii) транзакции не найдены.Ожидаемое поведение будет состоять в том, чтобы просто переместить следующую итерацию цикла в основной подпрограмме без проблем.Нет ничего, что могло бы повлиять на основную подпрограмму, если вызванная подпрограмма будет закрыта.
Я потратил довольно много времени, пытаясь решить проблему безрезультатно.Любые идеи, предложения или ответы будут с благодарностью.
В соответствии с запросом @Spring Filip ниже представлена сокращенная версия вызываемого субмара, GenerateReport.
Option Explicit
Option Private Module
Sub GenerateReport(ByRef Source_Array As Variant, ByRef KeyTailNum As String)
Dim i As Long
Dim CompositeKey As String
Dim Dict1 As Dictionary
Dim ItemComp_Array As Variant
Dim Coll As Collection
Set Dict1 = New Dictionary
Dict1.CompareMode = TextCompare
Set Coll = New Collection
' Build dictionary that summarizes transactions
For i = LBound(Source_Array, 1) To UBound(Source_Array, 1)
If Source_Array(i, 6) = KeyTailNum Then
CompositeKey = vbNullString
If Source_Array(i, 5) <> "MRO VENDOR" Then
If Source_Array(i, 5) = "ISSUE FROM STOCK" Then
'buid collection of IFS PNs
Coll.Add Source_Array(i, 1)
End If
'CompositeKey = PN,PO,Amount,Exp Type
CompositeKey = Join(Array(Source_Array(i, 1), _
Source_Array(i, 4), _
Abs(Source_Array(i, 3)), _
Source_Array(i, 5), KeyTailNum), "~~")
If Dict1.Exists(CompositeKey) Then
ItemComp_Array = Split(Dict1.Item(CompositeKey), "~~")
Dict1.Item(CompositeKey) = Join(Array(ItemComp_Array(0), _
ItemComp_Array(1), _
(CDbl(ItemComp_Array(2) + CDbl(Source_Array(i, 3)))), _
ItemComp_Array(3), _
ItemComp_Array(4), 0), "~~")
Else
'Item = PN, PN Des, Ammount, Exp Cat, Count, Place holder for averages
Dict1.Add CompositeKey, Join(Array(Source_Array(i, 1), _
Source_Array(i, 2), _
CDbl(Source_Array(i, 3)), _
Source_Array(i, 5), _
1, 0), "~~")
End If
Else
'Key = Exp Alpha Name; PN/Exp Remark; Rec Unique ID; Tail Number
CompositeKey = Join(Array(Source_Array(i, 1), _
Source_Array(i, 2), Source_Array(i, 7), KeyTailNum), "~~")
If Not Dict1.Exists(CompositeKey) Then
'Item = Exp Alpha Name; PN/Exp Remark; Amount; Exp Typ; Account;Rec Unique Id
Dict1.Add CompositeKey, Join(Array(Source_Array(i, 1), _
Source_Array(i, 2), _
CDbl(Source_Array(i, 3)), _
Source_Array(i, 5), _
Source_Array(i, 8), _
Source_Array(i, 7)), "~~")
End If
End If
End If
Next i
'Errors_Coll is public, BoolExitGenRprt is public
'**************************************************************************************************
'Conditional Exit of Sub
'**************************************************************************************************
'If there are no transactions found for this tail then go to the Next Tail Number if there is one
If Dict1.Count = 0 Then
Errors_Coll.Add KeyTailNum
BoolExitGenRprt = True
GoTo ClearAllVariables
End If
'**************************************************************************************************
'**************************************************************************************************
'Begin Other code to be executed
|
|
|
|
|
|
|
|
'End Other code to be excuted'
ClearAllVariables:
'Clear Variables
i = Empty
Set Dict1 = Nothing
CompositeKey = Empty
ItemComp_Array = Empty
Source_Array = Empty
End Sub