The trick писал(а):Нужно больше информации / кода, либо ехе файл.
Хакер писал(а):Стоп-стоп.
При выводе Run-time ошибок VB никогда не сообщает номер строки. Просто Type mismatch или Overflow и гадай где. А здес «in line 0». Стало быть речь идёт не о run-time error, а о compile-time error?
Это Run-time error, компиляция произведена успешно. Процедура имеет обработчик ошибок, использующий функцию Erl, которая почему-то вместо 484-ой строки выдаёт 0. Номер строки, где реально происходит ошибка я отловил, расставив по тексту процедуры подробное логгирование.
(Удалено.)
Более подробный текст процедуры приведён ниже. Она, к сожалению, очень большая, и я не могу её уменьшить, чтобы продемонстрировать ситуацию на маленьком фрагменте. Процедура имеет несколько вызовов типа GoSub/Return. Ошибка возникает в строке 484 в подпрограмме RESULT_VZAIM_SHIP_IN, которая вызывается из строки 254. Ошибка возникает только на определённой итерации цикла (строки 134-196) при значении RecVzm.VZ_ID = 5033.
В этой процедуре практически не используются объекты или классы, за исключением DAO. Все переменные вида "RecVzm.VZ_ID" - это структуры данных (массивы или нет). Переменные вида "t_REGVZAIM" - это как раз объекты DAO.Recordset, с которыми в частности работает цикл в строках 134-196.
- Код: Выделить всё
Public Function fnProcessResult() As Boolean
'<EhHeader>
On Error GoTo fnProcessResult_Err
100 PrintLog "==>> xxMProcessResult.fnProcessResult"
'</EhHeader>
Const ERR_LOC = "ПРОЦЕДУРА: fnProcessResult" & vbCrLf
Dim bRetVal As Boolean 'Возвращаемое значение
Dim bTransaction As Boolean 'Начата ли транзакция?
102 PrintLog "Формирование результирующей таблицы t_RESULT..."
104 CurrStage = STAGE3_PROCESS_RESULT ' Для ErrHeader
106 NG_ASSETS = fnGetNomenGroupID("__АКТИВЫ__", SPRAV_NG)
108 With frmMain.ProgressBar1
110 .Min = 1
112 nVzmCount = t_REGVZAIM.RecordCount
114 .Max = nVzmCount
116 .Value = 1
118 .Visible = True
End With
120 nVzmItem = 0&
122 With t_REGVZAIM
124 .Index = "VZ_DATE"
126 .MoveFirst
128 .MoveNext 'Пропуск VZ_DATE = "19.02.1982" (VZ_ID=1)
130 oWorkspase.BeginTrans
132 bTransaction = True
134 Do Until .EOF 'ПЕРЕБИРАЕМ ВЗАИМОРАСЧЁТЫ
136 nVzmItem = nVzmItem + 1&
138 If nVzmItem Mod 50& = 0& Then
140 oWorkspase.CommitTrans
142 bTransaction = False
144 With frmMain
146 .ProgressBar1.Value = nVzmItem
148 .StatusBar1.Panels(1).Text = "Запись: " & nVzmItem
150 DoEvents
End With
152 oWorkspase.BeginTrans
154 bTransaction = True
End If
156 If fnReadRegvzaim(t_REGVZAIM, RecVzm) = False Then
158 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnReadRegvzaim вернула ошибку."
160 GoTo HELL
End If
' Debug.Assert Not (RecVzm.VZ_ID = 5033)
162 With RecVzm
164 If (.VZ_SUM <> 0@) And (.VZ_NDS <> 0@) Then
166 .STAVKA_NDS = .VZ_NDS / .VZ_SUM
End If
End With
168 nOperTypId = fnOperTypId(RecVzm.OPER_ID, sOperAccDt, sOperAccCt)
170 If (nOperTypId = otpDT_VZAIM_CT_REMAINS) _
Or (nOperTypId = otpDT_REMAINS_CT_VZAIM) _
Or (nOperTypId = otpDT_VZAIM_CT_VZAIM) Then
172 If fnVzaim() = False Then 'ЗАГРУЖАЕМ РЕАЛИЗАЦИЮ.
174 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnVzaim вернула ошибку."
176 GoTo HELL
End If
End If
178 nRCashCount = 0&
180 GoSub ASSETS 'ЗАГРУЖАЕМ АКТИВЫ.
182 If fnDIRECT() = False Then 'ЗАГРУЖАЕМ РЕАЛИЗАЦИЮ.
184 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnDIRECT вернула ошибку."
186 GoTo HELL
End If
188 If nRCashCount = 0& Then 'Если платежей по поставкам
190 If fnAdvances() = False Then 'нет, то ЗАГРУЖАЕМ АВАНСЫ.
192 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnAdvances вернула ошибку."
194 GoTo HELL
End If
End If
196 .MoveNext
Loop
198 oWorkspase.CommitTrans
200 bTransaction = False
End With
202 bRetVal = True
204 GoTo HELL 'ВЫХОД
'===================================================================
' ПОДПРОГРАММА ЗАГРУЗКИ АКТИВОВ В aRecAssets
'-------------------------------------------------------------------
ASSETS:
206 ReDim aRecAssets(1& To ARR_BLOCK)
208 nAssCount = 0&
210 ReDim aResultAssFull(1& To ARR_BLOCK)
212 nRAssFullCount = 0&
214 With t_REGASSETS
216 .Index = "VZ_ID"
218 .SeekRecord "=", RecVzm.VZ_ID
220 If .NoMatch Then Return
222 Do Until .EOF
224 If (!VZ_ID <> RecVzm.VZ_ID) Then Exit Do
226 nAssCount = nAssCount + 1&
228 If nAssCount Mod ARR_BLOCK = 0& Then
230 ReDim Preserve aRecAssets(1& To nAssCount + ARR_BLOCK)
End If
232 If fnReadRegassets(t_REGASSETS, aRecAssets(nAssCount)) = False Then
234 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnReadRegassets вернула ошибку."
236 GoTo HELL
End If
238 GoSub COSTS 'ЗАГРУЖАЕМ РАСХОДЫ
240 GoSub RESULT_ASSETS_COSTS 'ФОРМИРУЕМ РЕЗУЛЬТАТ
242 For nRAssItem = 1& To nRAssCount
244 nRAssFullCount = nRAssFullCount + 1&
246 If nRAssFullCount Mod ARR_BLOCK = 0& Then
248 ReDim Preserve aResultAssFull(1& To nRAssFullCount + ARR_BLOCK)
End If
'Массив aResultAss обнуляется на каждой итерации цикла.
'Но нам нужны полные данные об активах для каждого VZ_ID
'(используется в RESULT_VZAIM_SHIP_IN), поэтому объединим
'их в отдельный массив.
250 aResultAssFull(nRAssFullCount) = aResultAss(nRAssItem)
Next
252 .MoveNext
Loop
254 GoSub RESULT_VZAIM_SHIP_IN 'ЗАГРУЖАЕМ ПОСТУПЛЕНИЯ
256 GoSub CASH_OUT 'ЗАГР.ОПЛАТЫ ПОСТАВЩИКАМ
258 If nRCashCount Then
260 If aResultCash(nRCashCount).VZ_ID = RecVzm.VZ_ID Then
262 GoSub PAY_OUT 'ТЕ ЖЕ ОПЛАТЫ, НО ИЗ t_REGVZAIM
End If
End If
End With
264 Return
'===================================================================
' ПОДПРОГРАММА ЗАГРУЗКИ РАСХОДОВ В aRecCosts
'-------------------------------------------------------------------
COSTS:
266 ReDim aRecCosts(1& To ARR_BLOCK)
268 nCostCount = 0&
270 With t_REGCOSTS
272 .Index = "ASS_ID"
274 .SeekRecord "=", aRecAssets(nAssCount).ASS_ID
276 If .NoMatch Then Return
278 Do Until .EOF
280 If (!ASS_ID <> aRecAssets(nAssCount).ASS_ID) Then Exit Do
282 nCostCount = nCostCount + 1
284 If nCostCount Mod ARR_BLOCK = 0& Then 'Приращаем массив.
286 ReDim Preserve aRecCosts(1& To nCostCount + ARR_BLOCK)
End If 'Получаем текущую запись
288 If fnReadRegcosts(t_REGCOSTS, aRecCosts(nCostCount)) = False Then
290 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnReadRegcosts вернула ошибку."
292 GoTo HELL
End If
294 .MoveNext
Loop
' ReDim Preserve aRecCosts(1& To nCostCount)
End With
296 Return
'===================================================================
' ПОДПРОГРАММА ФОРМИРОВАНИЯ И ЗАПИСИ РЕЗУЛЬТАТА
' ПО АКТИВАМ И РАСХОДАМ В aResultCos И aResultAss
'-------------------------------------------------------------------
RESULT_ASSETS_COSTS:
298 ReDim aResultCos(1& To ARR_BLOCK)
300 ReDim aResultAss(1& To ARR_BLOCK)
302 nRAssCount = 0&
304 nRCostCount = 0&
306 nRestSum = aRecAssets(nAssCount).ASS_SUM
308 nRestQnt = aRecAssets(nAssCount).ASS_QNT
310 If nCostCount > 0& Then 'Если текущая запись активов
312 For nCostItem = 1& To nCostCount 'связана с расходами, то
'распределяем активы по расходам.
314 nRAssCount = nRAssCount + 1&
316 If nRAssCount Mod ARR_BLOCK = 0& Then
318 ReDim Preserve aResultAss(1& To nRAssCount + ARR_BLOCK)
End If
320 With aResultAss(nRAssCount) 'Делаем записи в активах
322 .VZ_ID = RecVzm.VZ_ID
324 .VZ_DATE_ID = RecVzm.VZ_DATE
326 .VZ_ACC_ID = RecVzm.ACC_ID
328 .DEAL_ID = RecVzm.DEAL_ID
330 .ITEM_ID = RecVzm.ITEM_ID
332 .DATE_ID = aRecAssets(nAssCount).ASS_DATE
334 .DOC_ID = aRecAssets(nAssCount).DOC_ID
336 .OPER_ID = aRecAssets(nAssCount).OPER_ID
338 .ZATR_ID = aRecAssets(nAssCount).ZATR_ID
340 .PODRAZ_ID = aRecAssets(nAssCount).PODRAZ_ID
342 .ACC_ID = aRecAssets(nAssCount).ACC_ID
344 .NOMEN_ID = aRecAssets(nAssCount).NOMEN_ID
346 .DESCR_ID = aRecAssets(nAssCount).DESCR_ID
348 .REL_DOC_ID = aRecAssets(nAssCount).REL_DOC_ID
350 .SUM_CLEAN = aRecCosts(nCostItem).COST_SUM
352 .QUANTITY = aRecCosts(nCostItem).COST_QNT
354 .NG_ID = aRecCosts(nCostItem).NG_ID
356 .SUM_NDS = .SUM_CLEAN * RecVzm.STAVKA_NDS
358 .DATATYP_ID = enum_DATATYPES.dtypASSETS
360 nRestSum = nRestSum - .SUM_CLEAN
362 nRestQnt = nRestQnt - .QUANTITY
End With
364 nRCostCount = nRCostCount + 1&
366 If nRCostCount Mod ARR_BLOCK = 0& Then 'Приращаем массив.
368 ReDim Preserve aResultCos(1& To nRCostCount + ARR_BLOCK)
End If
370 With aResultCos(nRCostCount) 'Делаем записи в расходах.
372 .VZ_ID = RecVzm.VZ_ID
374 .VZ_DATE_ID = RecVzm.VZ_DATE
376 .VZ_ACC_ID = RecVzm.ACC_ID
378 .DEAL_ID = RecVzm.DEAL_ID
380 .ITEM_ID = RecVzm.ITEM_ID
382 .ZATR_ID = aRecAssets(nAssCount).ZATR_ID
384 .PODRAZ_ID = aRecAssets(nAssCount).PODRAZ_ID
386 .DATE_ID = aRecCosts(nCostItem).COST_DATE
388 .DOC_ID = aRecCosts(nCostItem).DOC_ID
390 .OPER_ID = aRecCosts(nCostItem).OPER_ID
392 .ACC_ID = aRecCosts(nCostItem).ACC_ID
394 .NOMEN_ID = aRecCosts(nCostItem).NOMEN_ID
396 .NG_ID = aRecCosts(nCostItem).NG_ID
398 .DESCR_ID = aRecCosts(nCostItem).DESCR_ID
400 .REL_DOC_ID = aRecCosts(nCostItem).REL_DOC_ID
402 .SUM_CLEAN = aRecCosts(nCostItem).COST_SUM
404 .QUANTITY = aRecCosts(nCostItem).COST_QNT
406 .SUM_NDS = .SUM_CLEAN * RecVzm.STAVKA_NDS
408 .DATATYP_ID = enum_DATATYPES.dtypCOSTS
End With
Next
End If
410 If (nCostCount = 0&) Or (nRestSum <> 0@) Then
'Если связанных расходов нет,
'или остались несвяз.активы,
412 nRAssCount = nRAssCount + 1&
414 If nRAssCount Mod ARR_BLOCK = 0& Then
416 ReDim Preserve aResultAss(1& To nRAssCount + ARR_BLOCK)
End If
418 With aResultAss(nRAssCount) 'Делаем записи в активах
420 .VZ_ID = RecVzm.VZ_ID
422 .VZ_DATE_ID = RecVzm.VZ_DATE
424 .VZ_ACC_ID = RecVzm.ACC_ID
426 .DEAL_ID = RecVzm.DEAL_ID
428 .ITEM_ID = RecVzm.ITEM_ID
430 .DATE_ID = aRecAssets(nAssCount).ASS_DATE
432 .DOC_ID = aRecAssets(nAssCount).DOC_ID
434 .OPER_ID = aRecAssets(nAssCount).OPER_ID
436 .ZATR_ID = aRecAssets(nAssCount).ZATR_ID
438 .PODRAZ_ID = aRecAssets(nAssCount).PODRAZ_ID
440 .ACC_ID = aRecAssets(nAssCount).ACC_ID
442 .NOMEN_ID = aRecAssets(nAssCount).NOMEN_ID
444 .DESCR_ID = aRecAssets(nAssCount).DESCR_ID
446 .REL_DOC_ID = aRecAssets(nAssCount).REL_DOC_ID
448 .SUM_CLEAN = nRestSum
450 .QUANTITY = nRestQnt
452 .NG_ID = NG_ASSETS
454 If AccInt(.ACC_ID) = 19 _
Or AccNum(.ACC_ID) = ACC_NDS_LEASING Then
456 .SUM_NDS = aRecAssets(nAssCount).ASS_NDS
Else
458 .SUM_NDS = .SUM_CLEAN * RecVzm.STAVKA_NDS
End If
460 .DATATYP_ID = enum_DATATYPES.dtypASSETS
End With
End If
462 If nRCostCount Then 'Запись на диск
464 For nRCostItem = 1& To nRCostCount
466 If AddNew_RESULT(aResultCos(nRCostItem)) = False Then
468 PrintLog ErrHeader & ERR_LOC & _
"Процедура AddNew_RESULT(aResultCos) вернула ошибку."
470 GoTo HELL
End If
Next
End If
472 If nRAssCount Then
474 For nRAssItem = 1& To nRAssCount
476 If AddNew_RESULT(aResultAss(nRAssItem)) = False Then
478 PrintLog ErrHeader & ERR_LOC & _
"Процедура AddNew_RESULT(aResultAss) вернула ошибку."
480 GoTo HELL
End If
Next
End If
482 Return
'===================================================================
' ПОДПРОГРАММА ФОРМИРОВАНИЯ И ЗАПИСИ РЕЗУЛЬТАТА
' ПО ВЗАИМОРАСЧЁТАМ В ЧАСТИ ПОСТУПЛЕНИЙ В aResultVzm
'-------------------------------------------------------------------
RESULT_VZAIM_SHIP_IN:
Debug.Assert Not (RecVzm.VZ_ID = 5033)
If RecVzm.VZ_ID = 5033 Then
PrintLog "Строка 484. ARR_BLOCK = " & ARR_BLOCK
PrintLog "LBound(aResultVzm) = " & LBound(aResultVzm)
PrintLog "UBound(aResultVzm) = " & UBound(aResultVzm)
End If
484 ReDim aResultVzm(1& To ARR_BLOCK)
If RecVzm.VZ_ID = 5033 Then PrintLog "Строка 486..."
486 nRVzmCount = 0&
488 If (RecVzm.VZ_SUM = 0@) And (RecVzm.VZ_NDS = 0@) Then Return
490 nRestSum = 0@ 'Все остатки активов считаем
492 nRestNds = 0@ 'суммированием
494 nRestQnt = 0@ '(поступления + / расходы -)
496 For nRAssFullItem = 1& To nRAssFullCount 'Перебираем активы.
'Считаем остатки активов. При этом пропускаем
'поступление НДС на 19-ый счёт (потому что мы уже
'начислили его по ставке в .SUM_NDS), но учитываем
'выбытие НДС по Д68.02К19.
498 b6802 = ((sOperAccDt = "68.02") Or (sOperAccCt = "68.02"))
500 With aResultAssFull(nRAssFullItem)
502 nOperTypId = fnOperTypId(.OPER_ID, sOperAccDt, sOperAccCt)
504 If (.IS_BUH_ONLY = False) Or b6802 Then
506 nRestSum = nRestSum + .SUM_CLEAN
508 nRestNds = nRestNds + .SUM_NDS
510 nRestQnt = nRestQnt + .QUANTITY
End If
End With
512 If IsCosts(aResultAssFull(nRAssFullItem).OPER_ID) = False Then
'Работаем сначала с расходами.
514 GoTo NEXT_RASS_ITEM '(там есть аналитика)
End If
516 nOperTypId = fnOperTypId(aResultAssFull(nRAssFullItem).OPER_ID, _
sOperAccDt, sOperAccCt)
518 If (sOperAccDt = "90.03") Or (sOperAccCt = "90.03") Then
520 GoTo NEXT_RASS_ITEM 'Пропускаем Д90.03-К19
End If
522 With aResultAssFull(nRAssFullItem)
'Проверяем: если аналитика, полученная из активов
'та же, что и в предыдущей записи, то новую запись
'не создаём, а добавляем суммы к предыдущей.
524 bIsGroup = False
526 If (nRVzmCount > 0&) Then
528 If (.ZATR_ID = aResultVzm(nRVzmCount).ZATR_ID) _
And (.PODRAZ_ID = aResultVzm(nRVzmCount).PODRAZ_ID) _
And (.NOMEN_ID = aResultVzm(nRVzmCount).NOMEN_ID) _
And (.NG_ID = aResultVzm(nRVzmCount).NG_ID) Then
530 bIsGroup = True
End If
End If
End With
532 If bIsGroup = False Then 'Если группировки нет,
534 nRVzmCount = nRVzmCount + 1& 'то приращаем массив.
536 If nRVzmCount Mod ARR_BLOCK = 0& Then
538 ReDim Preserve aResultVzm(1& To nRVzmCount + ARR_BLOCK)
End If
End If
540 With aResultVzm(nRVzmCount) 'Делаем записи о поступл.
542 If bIsGroup Then
544 .SUM_CLEAN = .SUM_CLEAN + aResultAssFull(nRAssFullItem).SUM_CLEAN
546 .SUM_NDS = .SUM_NDS + aResultAssFull(nRAssFullItem).SUM_NDS
548 .QUANTITY = .QUANTITY + aResultAssFull(nRAssFullItem).QUANTITY
Else
550 .VZ_ID = RecVzm.VZ_ID
552 .VZ_DATE_ID = RecVzm.VZ_DATE
554 .VZ_ACC_ID = RecVzm.ACC_ID
556 .DEAL_ID = RecVzm.DEAL_ID
558 .ITEM_ID = RecVzm.ITEM_ID
560 .DATE_ID = RecVzm.VZ_DATE
562 .DOC_ID = RecVzm.DOC_ID
564 .OPER_ID = RecVzm.OPER_ID
566 .DESCR_ID = RecVzm.DESCR_ID
568 .REL_DOC_ID = RecVzm.REL_DOC_ID
570 .ACC_ID = RecVzm.ACC_ID
572 .ZATR_ID = aResultAssFull(nRAssFullItem).ZATR_ID
574 .PODRAZ_ID = aResultAssFull(nRAssFullItem).PODRAZ_ID
576 .NOMEN_ID = aResultAssFull(nRAssFullItem).NOMEN_ID
578 .NG_ID = aResultAssFull(nRAssFullItem).NG_ID
580 .SUM_CLEAN = aResultAssFull(nRAssFullItem).SUM_CLEAN
582 .SUM_NDS = aResultAssFull(nRAssFullItem).SUM_NDS
584 .QUANTITY = aResultAssFull(nRAssFullItem).QUANTITY
586 .DATATYP_ID = enum_DATATYPES.dtypSHIP_IN
End If
End With
'В результате группировки сумма по строке может обнулиться.
'Такую строку записывать в базу не нужно.
588 If bIsGroup And (aResultVzm(nRVzmCount).SUM_CLEAN = 0@) And (aResultVzm(nRVzmCount).SUM_NDS = 0@) Then
590 nRVzmCount = nRVzmCount - 1&
End If
NEXT_RASS_ITEM:
Next
592 nEntryCount = 0&
594 If (nRestSum <> 0@) Or b6802 Then 'Если осталась нераспр.сумма,
596 For nRAssFullItem = 1& To nRAssFullCount 'то ещё раз перебираем активы.
598 If IsVzaim(aResultAssFull(nRAssFullItem).OPER_ID) = False Then
'Работаем теперь с пос-
600 GoTo NEXT_RASS_ITEM2 'туплениями (меньше аналитики).
End If
602 nEntryCount = nEntryCount + 1&
604 nRVzmCount = nRVzmCount + 1& 'Приращаем массив.
606 If nRVzmCount Mod ARR_BLOCK = 0& Then
608 ReDim Preserve aResultVzm(1& To nRVzmCount + ARR_BLOCK)
End If
610 With aResultVzm(nRVzmCount) 'Делаем записи о поступлении
612 .VZ_ID = RecVzm.VZ_ID
614 .VZ_DATE_ID = RecVzm.VZ_DATE
616 .VZ_ACC_ID = RecVzm.ACC_ID
618 .DEAL_ID = RecVzm.DEAL_ID
620 .ITEM_ID = RecVzm.ITEM_ID
622 .DATE_ID = RecVzm.VZ_DATE
624 .DOC_ID = RecVzm.DOC_ID
626 .OPER_ID = RecVzm.OPER_ID
628 .DESCR_ID = RecVzm.DESCR_ID
630 .REL_DOC_ID = RecVzm.REL_DOC_ID
632 .ACC_ID = RecVzm.ACC_ID
634 .ZATR_ID = aResultAssFull(nRAssFullItem).ZATR_ID
636 .PODRAZ_ID = aResultAssFull(nRAssFullItem).PODRAZ_ID
638 .NOMEN_ID = aResultAssFull(nRAssFullItem).NOMEN_ID
640 .NG_ID = aResultAssFull(nRAssFullItem).NG_ID
'В активах должно быть всего две записи
'о поступлении: основная сумма и НДС.
642 If nEntryCount > 2 Then
644 PrintLog ErrHeader & ERR_LOC & _
"Подпрограмма RESULT_VZAIM_SHIP_IN обнаружила более " & _
"двух записей о поступлении активов по одному VZ_ID."
646 GoTo HELL
End If
648 If sOperAccDt = "76.02" _
And nOperTypId = otpDT_VZAIM_CT_ASSETS Then
'По операциям возврата товаров поставщику
'добавляем НДС по взаиморасчётам к проводке Д76.02 К-активы
'вместо Д76.02 К68.02 (где она должна быть), чтобы не
'искать аналитику для суммы НДС на счёте 76.
650 .SUM_CLEAN = -nRestSum 'На сумму остатка.
652 .QUANTITY = -nRestQnt
654 .SUM_NDS = -nRestNds
656 ElseIf aResultAssFull(nRAssFullItem).SUM_CLEAN <> 0@ Then
658 .SUM_CLEAN = -nRestSum 'На сумму остатка.
660 .QUANTITY = -nRestQnt
662 .SUM_NDS = 0@
Else
664 .SUM_CLEAN = 0@
666 .QUANTITY = 0@
668 .SUM_NDS = -nRestNds
End If
670 .DATATYP_ID = enum_DATATYPES.dtypSHIP_IN
End With
NEXT_RASS_ITEM2:
Next
End If
672 If nRVzmCount Then 'Запись на диск
674 For nRVzmItem = 1& To nRVzmCount
676 If AddNew_RESULT(aResultVzm(nRVzmItem)) = False Then
678 PrintLog ErrHeader & ERR_LOC & _
"Процедура AddNew_RESULT(aResultVzm) вернула ошибку."
680 GoTo HELL
End If
Next
End If
682 Return
'===================================================================
' ПОДПРОГРАММА ЗАГРУЗКИ ИСХОДЯЩИХ ПЛАТЕЖЕЙ В aRecCash
' А ТАКЖЕ ФОРМИРОВАНИЯ И ЗАПИСИ РЕЗУЛЬТАТА
' ПО ИСХОДЯЩИМ ПЛАТЕЖАМ В aResultCash
'-------------------------------------------------------------------
CASH_OUT:
684 ReDim aRecCash(1& To ARR_BLOCK)
686 nCashCount = 0&
688 nFullSum = 0@
690 nFullNds = 0@
692 With t_REGCASH
694 .Index = "VZ_ID_SHIPPING"
696 .SeekRecord "=", RecVzm.VZ_ID
698 If .NoMatch Then Return
700 Do Until .EOF
702 If (!VZ_ID_SHIPPING <> RecVzm.VZ_ID) Then Exit Do
704 nCashCount = nCashCount + 1&
706 If nCashCount Mod ARR_BLOCK = 0& Then 'Приращаем массив.
708 ReDim Preserve aRecCash(1& To nCashCount + ARR_BLOCK)
End If 'Получаем текущую запись
710 If fnReadRegcash(t_REGCASH, aRecCash(nCashCount)) = False Then
712 PrintLog ErrHeader & ERR_LOC & _
"Процедура fnReadRegcash вернула ошибку."
714 GoTo HELL
End If
716 nFullSum = nFullSum + aRecCash(nCashCount).CASH_SUM
718 nFullNds = nFullNds + aRecCash(nCashCount).CASH_NDS
720 .MoveNext
Loop
End With
'ФОРМИРУЕМ РЕЗУЛЬТАТ
'-------------------------------------------------------------------
722 ReDim aResultCash(1& To ARR_BLOCK)
724 nRCashCount = 0&
'Этот коэффициент показывает, во сколько раз сумма платежей
'больше суммы поставки (возможно при корректировках)
726 nCoeff = (nFullSum + nFullNds) / (RecVzm.VZ_SUM + RecVzm.VZ_NDS)
728 nRestSum = 0@ 'Суммы по поставке, индексирован-
730 nRestNds = 0@ 'ные на nCoeff по платежам.
732 nRestQnt = 0@
734 For nRVzmItem = 1& To nRVzmCount
736 With aResultVzm(nRVzmItem)
738 .TMP_SUM = .SUM_CLEAN * nCoeff
740 .TMP_NDS = .SUM_NDS * nCoeff
742 .TMP_QNT = .QUANTITY
744 nRestSum = nRestSum + .TMP_SUM
746 nRestNds = nRestNds + .TMP_NDS
748 nRestQnt = nRestQnt + .TMP_QNT
'Погрешность округления
750 If (nRVzmItem = nRVzmCount) And (nFullSum <> nRestSum) Then
752 .TMP_SUM = .TMP_SUM + nFullSum - nRestSum
754 .TMP_NDS = .TMP_NDS + nFullNds - nRestNds
756 nRestSum = nFullSum
758 nRestNds = nFullNds
End If
End With
Next
760 If CBool(nRestQnt) Then 'Цена (с НДС)
762 nPrice = (nRestSum + nRestNds) / nRestQnt
Else
764 nPrice = 0#
End If
766 nExtractNds = RecVzm.STAVKA_NDS / (1 + RecVzm.STAVKA_NDS)
768 For nCashItem = 1& To nCashCount 'Перебираем платежи.
770 With aRecCash(nCashItem)
772 nCurSum = .CASH_SUM + .CASH_NDS
774 If CBool(nRestQnt) Then
776 nCurQnt = nCurSum / nPrice
Else
778 nCurQnt = 0@
End If
End With
780 For nRVzmItem = 1& To nRVzmCount 'Перебираем взаиморасчёты.
782 With aResultVzm(nRVzmItem)
784 If (.TMP_SUM = 0@) And (.TMP_NDS = 0@) Then
786 GoTo NEXT_VZM_ITEM
End If
End With
788 nRCashCount = nRCashCount + 1& 'Приращаем массив
790 If nRCashCount Mod ARR_BLOCK = 0& Then
792 ReDim Preserve aResultCash(1& To nRCashCount + ARR_BLOCK)
End If
794 With aResultVzm(nRVzmItem)
'Если сумма текущего платежа недостаточна, то списываем
'платёж полностью. Обычно все суммы отрицательные (пла-
'тёж - всегда отрицательный).
796 If (nCurSum > (.TMP_SUM + .TMP_NDS)) Then
798 With aResultCash(nRCashCount)
800 .SUM_NDS = nCurSum * nExtractNds
802 .SUM_CLEAN = nCurSum - .SUM_NDS
804 .QUANTITY = nCurQnt
806 nCurSum = 0@
808 nCurQnt = 0@
810 aResultVzm(nRVzmItem).TMP_SUM = aResultVzm(nRVzmItem).TMP_SUM - .SUM_CLEAN
812 aResultVzm(nRVzmItem).TMP_NDS = aResultVzm(nRVzmItem).TMP_NDS - .SUM_NDS
814 aResultVzm(nRVzmItem).TMP_QNT = aResultVzm(nRVzmItem).TMP_QNT - .QUANTITY
End With
'А если платежа хватает, то списываем из взаиморасчётов.
Else
816 With aResultCash(nRCashCount)
818 .SUM_NDS = aResultVzm(nRVzmItem).TMP_NDS
820 .SUM_CLEAN = aResultVzm(nRVzmItem).TMP_SUM
822 .QUANTITY = aResultVzm(nRVzmItem).TMP_QNT
824 nCurSum = nCurSum - aResultVzm(nRVzmItem).TMP_SUM
826 nCurSum = nCurSum - aResultVzm(nRVzmItem).TMP_NDS
828 nCurQnt = nCurQnt - aResultVzm(nRVzmItem).TMP_QNT
830 aResultVzm(nRVzmItem).TMP_SUM = 0@
832 aResultVzm(nRVzmItem).TMP_NDS = 0@
834 aResultVzm(nRVzmItem).TMP_QNT = 0@
End With
End If
836 nRestSum = nRestSum - aResultCash(nRCashCount).SUM_CLEAN
838 nRestNds = nRestNds - aResultCash(nRCashCount).SUM_NDS
840 nRestQnt = nRestQnt - aResultCash(nRCashCount).QUANTITY
842 With aResultCash(nRCashCount) 'Переносим аналитику.
844 .VZ_ID = aResultVzm(nRVzmItem).VZ_ID
846 .VZ_DATE_ID = aResultVzm(nRVzmItem).DATE_ID
848 .VZ_ACC_ID = aResultVzm(nRVzmItem).ACC_ID
850 .DEAL_ID = aResultVzm(nRVzmItem).DEAL_ID
852 .ITEM_ID = aResultVzm(nRVzmItem).ITEM_ID
854 .ZATR_ID = aResultVzm(nRVzmItem).ZATR_ID
856 .PODRAZ_ID = aResultVzm(nRVzmItem).PODRAZ_ID
858 .NOMEN_ID = aResultVzm(nRVzmItem).NOMEN_ID
860 .NG_ID = aResultVzm(nRVzmItem).NG_ID
862 .DATE_ID = aRecCash(nCashItem).CASH_DATE
864 .DOC_ID = aRecCash(nCashItem).DOC_ID
866 .OPER_ID = aRecCash(nCashItem).OPER_ID
868 .ACC_ID = aRecCash(nCashItem).ACC_ID
870 .DESCR_ID = aRecCash(nCashItem).DESCR_ID
872 .REL_DOC_ID = aRecCash(nCashItem).REL_DOC_ID
874 .DATATYP_ID = enum_DATATYPES.dtypCASH_OUT
End With
'Погрешность округления
876 If (nRestSum <> -nRestNds) _
And (Abs(nRestSum + nRestNds) < 0.0004@) Then
878 With aResultCash(nRCashCount)
880 If (Abs(nRestSum) > Abs(nRestNds)) Then
882 .SUM_CLEAN = .SUM_CLEAN - nRestSum - nRestNds
884 ElseIf nRestSum = nRestNds Then
886 .SUM_CLEAN = .SUM_CLEAN - nRestSum
888 .SUM_NDS = .SUM_NDS - nRestNds
Else
890 .SUM_NDS = .SUM_NDS - nRestSum - nRestNds
End If
End With
End If
End With
892 If (nCurSum = 0@) Then 'Проверка окончания работы
894 If (nRestSum + nRestNds = 0@) Then
896 If (nRVzmItem = nRVzmCount) Then
Exit For
Else
898 If (aResultVzm(nRVzmItem + 1&).TMP_SUM = 0@) _
And (aResultVzm(nRVzmItem + 1&).TMP_NDS = 0@) Then
Exit For
Else
'Обрабатываем ситуации, когда все платежи
'уже перераспределены по взаиморасчётам, но
'ещё остались записи в aResultVzm, которые
'в сумме = 0@. В этом случае мы переприсвоим
'значение nCurSum на сумму взаиморасчётов из
'aResultVzm. Надо только определить, с какой
'строкой aResultVzm мы продолжим работу.
900 If (aResultVzm(nRVzmItem).TMP_SUM + _
aResultVzm(nRVzmItem).TMP_NDS <> 0@) Then
902 nCurSum = aResultVzm(nRVzmItem).TMP_SUM + aResultVzm(nRVzmItem).TMP_NDS
904 nRVzmItem = nRVzmItem - 1
Else
906 nCurSum = aResultVzm(nRVzmItem + 1&).TMP_SUM _
+ aResultVzm(nRVzmItem + 1&).TMP_NDS
End If
End If
End If
Else
'Если платежей для распределения больше нет,
'а nRestSum<>0, то мы продолжае мобрабатывать
'ситуацию, описанную выше, и стараемся не выходить из цикла.
908 If (nCashItem = nCashCount) Then
910 If (nRVzmItem = nRVzmCount) Then
Exit For
Else
912 If (aResultVzm(nRVzmItem + 1&).TMP_SUM = 0@) _
And (aResultVzm(nRVzmItem + 1&).TMP_NDS = 0@) Then
Exit For
Else
914 If (aResultVzm(nRVzmItem).TMP_SUM + _
aResultVzm(nRVzmItem).TMP_NDS <> 0@) Then
916 nCurSum = aResultVzm(nRVzmItem).TMP_SUM + aResultVzm(nRVzmItem).TMP_NDS
918 nRVzmItem = nRVzmItem - 1
Else
920 nCurSum = aResultVzm(nRVzmItem + 1&).TMP_SUM _
+ aResultVzm(nRVzmItem + 1&).TMP_NDS
End If
End If
End If
Else
Exit For
End If
End If
End If
NEXT_VZM_ITEM:
Next
Next
922 nRestSum = 0@ 'Погрешность округления
924 nRestNds = 0@
926 For nRCashItem = 1& To nRCashCount
928 With aResultCash(nRCashItem)
930 nRestSum = nRestSum + .SUM_CLEAN
932 nRestNds = nRestNds + .SUM_NDS
End With
Next
934 If ((Abs(nFullSum - nRestSum) > 0.001@) _
Or (Abs(nFullNds - nRestNds) > 0.001@)) Then
936 PrintLog ErrHeader & ERR_LOC & _
"Ошибка распределения исходящих платежей."
938 GoTo HELL
End If
940 With aResultCash(nRCashCount)
942 .SUM_CLEAN = .SUM_CLEAN + nFullSum - nRestSum
944 .SUM_NDS = .SUM_NDS + nFullNds - nRestNds
End With
946 If nRCashCount Then 'Запись на диск
948 For nRCashItem = 1& To nRCashCount
950 If AddNew_RESULT(aResultCash(nRCashItem)) = False Then
952 PrintLog ErrHeader & ERR_LOC & _
"Процедура AddNew_RESULT(aResultCash) вернула ошибку."
954 GoTo HELL
End If
Next
End If
956 Return
'===================================================================
' ПОДПРОГРАММА ФОРМИРОВАНИЯ И ЗАПИСИ РЕЗУЛЬТАТА
' ПО ИСХОДЯЩИМ ПЛАТЕЖАМ (ВЗАИМОРАСЧЁТЫ) В aResultPay
'-------------------------------------------------------------------
PAY_OUT:
958 ReDim aResultPay(1& To ARR_BLOCK)
960 nRPayCount = 0&
962 For nRCashItem = 1& To nRCashCount
'Проверяем: если аналитика, полученная из ДДС
'та же, что и в предыдущей записи, то новую запись
'не создаём, а добавляем суммы к предыдущей.
964 bIsGroup = False
966 With aResultCash(nRCashItem)
968 If (nRPayCount > 0&) Then
970 If (.ZATR_ID = aResultPay(nRPayCount).ZATR_ID) _
And (.PODRAZ_ID = aResultPay(nRPayCount).PODRAZ_ID) _
And (.NOMEN_ID = aResultPay(nRPayCount).NOMEN_ID) _
And (.NG_ID = aResultPay(nRPayCount).NG_ID) _
And (.DATE_ID = aResultPay(nRPayCount).DATE_ID) Then
972 bIsGroup = True
End If
End If
End With
974 If bIsGroup = False Then 'Если группировки нет, то
976 nRPayCount = nRPayCount + 1& 'приращаем массив
978 If nRPayCount Mod ARR_BLOCK = 0& Then
980 ReDim Preserve aResultPay(1& To nRPayCount + ARR_BLOCK)
End If
End If
982 With aResultPay(nRPayCount) 'Делаем записи о поступл.
984 If bIsGroup Then
986 .SUM_CLEAN = .SUM_CLEAN - aResultCash(nRCashItem).SUM_CLEAN
988 .SUM_NDS = .SUM_NDS - aResultCash(nRCashItem).SUM_NDS
990 .QUANTITY = .QUANTITY - aResultCash(nRCashItem).QUANTITY
Else
992 .VZ_ID = aResultCash(nRCashItem).VZ_ID
994 .VZ_DATE_ID = aResultCash(nRCashItem).DATE_ID
996 .DATE_ID = aResultCash(nRCashItem).DATE_ID
998 .DOC_ID = aResultCash(nRCashItem).DOC_ID
1000 .DEAL_ID = aResultCash(nRCashItem).DEAL_ID
1002 .ITEM_ID = aResultCash(nRCashItem).ITEM_ID
1004 .OPER_ID = aResultCash(nRCashItem).OPER_ID
1006 .ZATR_ID = aResultCash(nRCashItem).ZATR_ID
1008 .PODRAZ_ID = aResultCash(nRCashItem).PODRAZ_ID
1010 .NOMEN_ID = aResultCash(nRCashItem).NOMEN_ID
1012 .NG_ID = aResultCash(nRCashItem).NG_ID
1014 .DESCR_ID = aResultCash(nRCashItem).DESCR_ID
1016 .REL_DOC_ID = aResultCash(nRCashItem).REL_DOC_ID
1018 .SUM_CLEAN = -aResultCash(nRCashItem).SUM_CLEAN
1020 .SUM_NDS = -aResultCash(nRCashItem).SUM_NDS
1022 .QUANTITY = -aResultCash(nRCashItem).QUANTITY
1024 .DATATYP_ID = enum_DATATYPES.dtypPAYMENTS
1026 .VZ_ACC_ID = AccIdDebt(.OPER_ID, aResultCash(nRCashItem).ACC_ID)
1028 If .VZ_ACC_ID = aResultCash(nRCashItem).ACC_ID Then
1030 .VZ_ACC_ID = AccIdCred(.OPER_ID, aResultCash(nRCashItem).ACC_ID)
End If
1032 .ACC_ID = .VZ_ACC_ID
End If
End With
'В результате группировки сумма по строке может обнулиться.
'Такую строку записывать в базу не нужно.
1034 If bIsGroup And (aResultPay(nRPayCount).SUM_CLEAN = 0@) _
And (aResultPay(nRPayCount).SUM_NDS = 0@) Then
1036 nRPayCount = nRPayCount - 1&
End If
Next
1038 If nRPayCount Then 'Запись на диск
1040 For nRPayItem = 1& To nRPayCount
1042 If AddNew_RESULT(aResultPay(nRPayItem)) = False Then
1044 PrintLog ErrHeader & ERR_LOC & _
"Процедура AddNew_RESULT(aResultPay) вернула ошибку."
1046 GoTo HELL
End If
Next
End If
1048 Return
'===================================================================
' ВЫХОД
'-------------------------------------------------------------------
HELL:
On Error Resume Next
1050 frmMain.StatusBar1.Panels(1).Text = ""
1052 frmMain.ProgressBar1.Visible = False
1054 PrintLog "Процедура fnProcessResult " & _
IIf(bRetVal, "завершена успешно.", "не завершена.")
1056 nRecord = 0
1058 If bTransaction Then oWorkspase.Rollback
1060 fnProcessResult = bRetVal
1062 CurrStage = STAGE0_DOING_NOTHING ' Для ErrHeader
'<EhFooter>
1064 PrintLog "<<== xxMProcessResult.fnProcessResult"
Exit Function
fnProcessResult_Err:
1066 PrintLog ErrHeader
1068 PrintLog "ERROR!!! " & Err.Description & _
" in xxMProcessResult.fnProcessResult " & _
"in line " & Erl, True, True, _
Err.HelpFile, Err.HelpContext
1070 GoTo HELL
'</EhFooter>
End Function
