Attribute VB_Name = "CALCULATE_CELL_R"
' Модуль расчета отчета при режиме ввода/редактирования
Option Explicit
Private hWnd As Long
' -------------------------------------------------------------------------------------------------------
' Процедура расчета при режиме ввода
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub CALC_PART_REPORT()
Dim lnRowCell, lnColumnCell, lnCellLink, pnWhatCalculate, nCnt, nCntCol, lnRazdel, lbResult, i As Integer
Dim pbCondition As Boolean
Dim lnCountAllRow, lnCountAllColumn, lnColumn1, lnRow1 As Long
Dim lSheetsReport, lSheetsService, oldSheet As Object

    On Error GoTo doError
    ThisWorkbook.Sheets("Service").Range("A38").Value = 0
    Sheets(Sheets("Service").Range("B19").Text).Activate
    Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    Set lSheetsService = Sheets("Service")

    With ThisWorkbook.Sheets("Service")
        pnAddress_Row = .Range("C5")
        pnAddress_Col = .Range("C6")
    End With
    
    ' Определим активную ячейку
    lnRowCell = ActiveCell.row
    lnColumnCell = ActiveCell.column
    lnCellLink = lSheetsReport.Cells(lnRowCell, 1)   'считаем LINK колонки
    If lnCellLink = 0 Then Exit Sub ' Если Link = 0 Не расчитываем
    lnCountAllRow = Sheets("Service").Range("A9")
    lnCountAllColumn = Sheets("Service").Range("A10")
    
    If lnRowCell >= pnAddress_Row And _
        lnRowCell <= lnCountAllRow + pnAddress_Row - 1 And _
        lnColumnCell >= pnAddress_Col And _
        lnColumnCell <= pnAddress_Col + lnCountAllColumn - 1 Then
        ' Попадает в виртуальное поле ввода защита листа - снять
        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
        pbCondition = True
        pnWhatCalculate = 1 '(1 - ячейка, 2 - строка, 3 - графа, 4 - весь документ)
        MODE_CALCULATE.Show ' вызов формы расчета режима
        If pbFormCancel Then
            pbCondition = MODE_CALCULATE.pbCondition
            pnWhatCalculate = MODE_CALCULATE.pnWhatCalculate
            Unload MODE_CALCULATE
            ' Блокировка экрана
            hWnd = FindWindow("XLMAIN", 0)
            Application.StatusBar = "Подождите ... Идет расчет отчета"
            LockWindowUpdate (hWnd)
            'Посмотрим а загружена ли выборка с SQLServer для расчета
            If Sheets("Service").Range("A25") = 0 And pbCondition Then
                ' Очистка Базы с выборкой
                Call CLEAR_TABLE_SQLDATA1
                ' сделаем загрузку данных
                Call GetSQLData_CALC
                Sheets("Service").Range("A25") = 1
                Sheets(Sheets("Service").Range("B19").Text).Select
            End If
            Application.Calculation = xlCalculationManual
            Select Case pnWhatCalculate
                Case 1  'Расчет для ячейки
                        'проверим тип листа
                        lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
                        lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = lSheetsService.Range("B20")
                        lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
                        
                        If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
                            lbResult = CALL_FILL_CELL(pbCondition, lnCellLink, lnRowCell, lnColumnCell)
                        End If
                Case 2 ' расчет для строки
                    'проверим тип листа
                    lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
                    lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = lSheetsService.Range("B20")
                    lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
                    
                    If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
                        For nCnt = 1 To lnCountAllColumn
                            lnColumnCell = pnAddress_Col + nCnt - 1
                            lbResult = CALL_FILL_CELL(pbCondition, lnCellLink, lnRowCell, lnColumnCell)
                        Next
                    End If
                Case 3 ' Расчет для графы
                    'проверим тип листа
                    lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
                    lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = lSheetsService.Range("B20")
                    lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
                    
                    If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
                        For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
                            lnCellLink = lSheetsReport.Cells(nCnt, 1)
                            If lnCellLink <> 0 Then
                                lbResult = CALL_FILL_CELL(pbCondition, lnCellLink, nCnt, lnColumnCell)
                            End If
                        Next
                    End If
                Case 4 ' Расчет всего документа
                    With lSheetsService.Range("KRIT_RAZDEL")
                         lnColumn1 = .column
                         lnRow1 = .row
                    End With
                    Set oldSheet = Application.ActiveWorkbook.Sheets(lSheetsService.Range("B19").Text)
                    For i = 1 To lSheetsService.Range("B23")
                        ' установим страницу
                        ' зададим критерий
                        lSheetsService.Cells(lnRow1 + 1, lnColumn1) = i
                        If lSheetsService.Range("B23") = 1 Then
                            Set lSheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Range("B19").Text)
                        Else
                            lSheetsService.Cells(lnRow1 + 3, lnColumn1).CALCULATE
                            Set lSheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
                        End If
                        lSheetsReport.Activate
                        ' защита листа - снять
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                        lnCountAllRow = Sheets("Service").Range("A9")
                        lnCountAllColumn = Sheets("Service").Range("A10")
                        With lSheetsService
                            pnAddress_Row = .Range("C5")
                            pnAddress_Col = .Range("C6")
                        End With
                        'проверим тип листа
                        lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
                        lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = i
                        lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
                        
                        If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
                            
                            For nCnt = pnAddress_Row To lnCountAllRow + 1
                                lnCellLink = lSheetsReport.Cells(nCnt, 1)
                                If lnCellLink <> 0 Then
                                    For nCntCol = 1 To lnCountAllColumn
                                        lnColumnCell = pnAddress_Col + nCntCol - 1
                                        lbResult = CALL_FILL_CELL(pbCondition, lnCellLink, nCnt, lnColumnCell)
                                    Next
                                End If
                            Next
                            ' защита листа - поставить
                            lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                        End If
                    Next
                    oldSheet.Activate
                Case 5 ' Расчет листа
                    'проверим тип листа
                    lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
                    lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = lSheetsService.Range("B20")
                    lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
                    
                    If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
                        For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
                            Application.StatusBar = "Строка " + VBA.Trim(VBA.str(nCnt)) + " из " + VBA.Trim(VBA.str(pnAddress_Row + lnCountAllRow + 1))
                            lnCellLink = lSheetsReport.Cells(nCnt, 1)
                            If lnCellLink <> 0 Then
                                For nCntCol = 1 To lnCountAllColumn
                                    lnColumnCell = pnAddress_Col + nCntCol - 1
                                    lbResult = CALL_FILL_CELL(pbCondition, lnCellLink, nCnt, lnColumnCell)
                                Next
                            End If
                        Next
                    End If
            End Select
            ' Update screen
            Application.Calculation = xlCalculationAutomatic
            LockWindowUpdate (0)
            Application.StatusBar = False
        End If
        ' защита листа - поставить
         lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    End If
    Sheets("SQLDATA1").Visible = False

Exit Sub
doError:
    Call ERROR_EVENT("CALC_PART_REPORT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура выцепления формулы - условия для ячейки при режиме ввода/редактирования
' LinkBar_c - Link records in sheets "Отчет"
' LinkGraf_c    - порядковый номер столбца num = 1 для положительного, 2 для отрицательного условия
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Function F_GET_CELL_COND_OWN(ByVal LinkBar_c, ByVal LinkGraf_c, znak As Integer, ByRef str2 As String) As String
Dim lcCond_c As String
Dim lnLinkBar_c, lnLinkGraf_c, lnColumn, lnColumnCount, lnRow, lnColumn1, lnColumnCount1, lnRow1 As Long
Dim lSheetsCond As Object, lSheetsAlg As Object

    On Error GoTo doError

    Set lSheetsCond = Sheets("OTBOR_COND")
    Set lSheetsAlg = Sheets("ALG")
    lnLinkBar_c = LinkBar_c
    lnLinkGraf_c = LinkGraf_c

Top:
    With lSheetsAlg
    ' Определим , а есть ли расчет через формулу для данной ячейки
        .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN).Value = lnLinkBar_c
        .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 1).Value = lnLinkGraf_c
        .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 3).Value = 1
    End With
    ' Проверим , а есть ли запись ( или их несколько )
    lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN).CALCULATE
    lSheetsAlg.Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN + 1).CALCULATE
    lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1).CALCULATE
    lSheetsAlg.Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN + 2).CALCULATE
    lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2).CALCULATE
    
    If lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1) = 1 Or lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2) = 1 Then
        If lnLinkGraf_c > 0 And lnLinkBar_c = -1 Then
            'Нет возможности считать формулу
            F_GET_CELL_COND_OWN = ""
            ' Сброс критерия
            With lSheetsAlg
                .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
            End With
            Exit Function
        End If
        Select Case lnLinkGraf_c
            Case Is > 0
                 lnLinkGraf_c = 0
            Case Is = 0
                 lnLinkGraf_c = LinkGraf_c
                 lnLinkBar_c = -1
        End Select
        GoTo Top
    Else

        With lSheetsCond
            ' Заполним критерий отбора для условия
            .Cells(KRIT_STR_COND_ROW + 1, KRIT_STR_COND_COLUMN).Value = lnLinkBar_c
            .Cells(KRIT_STR_COND_ROW + 1, KRIT_STR_COND_COLUMN + 1).Value = lnLinkGraf_c
            ' Проверим , а есть ли запись ( или их несколько)
            
            .Cells(KRIT_STR_COND_ROW + 2, KRIT_STR_COND_COLUMN).CALCULATE
            .Cells(KRIT_STR_COND_ROW + 3, KRIT_STR_COND_COLUMN + 1).CALCULATE
            .Cells(KRIT_STR_COND_ROW + 2, KRIT_STR_COND_COLUMN + 1).CALCULATE
            .Cells(KRIT_STR_COND_ROW + 3, KRIT_STR_COND_COLUMN + 2).CALCULATE
            .Cells(KRIT_STR_COND_ROW + 2, KRIT_STR_COND_COLUMN + 2).CALCULATE
            
            If .Cells(KRIT_STR_COND_ROW + 2, KRIT_STR_COND_COLUMN + 2) = 1 Or .Cells(KRIT_STR_COND_ROW + 2, KRIT_STR_COND_COLUMN + 1) = 1 Then ' Записи нет
                    If lnLinkGraf_c > 0 And lnLinkBar_c = -1 Then
                        'Нет возможности считать условие
                        F_GET_CELL_COND_OWN = ""
                        ' Сброс критерия
                        .Range(.Cells(KRIT_STR_COND_ROW + 1, KRIT_STR_COND_COLUMN), .Cells(KRIT_STR_COND_ROW + 1, KRIT_STR_COND_COLUMN + KRIT_STR_COND_COLUMNCOUNT - 2)) = ""
                        Exit Function
                    End If
                    Select Case lnLinkGraf_c
                        Case Is > 0
                                lnLinkGraf_c = 0
                        Case Is = 0
                                lnLinkGraf_c = LinkGraf_c
                                lnLinkBar_c = -1
                    End Select
                    GoTo Top
            Else
                ' Считаем значение
                    .Cells(KRIT_STR_COND_ROW + 5, KRIT_STR_COND_COLUMN).CALCULATE
                    lcCond_c = .Cells(KRIT_STR_COND_ROW + 5, KRIT_STR_COND_COLUMN)
                    str2 = ""
                    .Cells(KRIT_STR_COND_ROW + 7, KRIT_STR_COND_COLUMN).CALCULATE
                    .Cells(KRIT_STR_COND_ROW + 7, KRIT_STR_COND_COLUMN + 1).CALCULATE
                    If .Cells(KRIT_STR_COND_ROW + 7, KRIT_STR_COND_COLUMN + 1) = 0 Then str2 = .Cells(KRIT_STR_COND_ROW + 7, KRIT_STR_COND_COLUMN)
                .Cells(KRIT_STR_COND_ROW + 6, KRIT_STR_COND_COLUMN).CALCULATE
                znak = .Cells(KRIT_STR_COND_ROW + 6, KRIT_STR_COND_COLUMN)
                F_GET_CELL_COND_OWN = lcCond_c
            End If
            'Очистим поля критерия
            .Range(.Cells(KRIT_STR_COND_ROW + 1, KRIT_STR_COND_COLUMN), .Cells(KRIT_STR_COND_ROW + 1, KRIT_STR_COND_COLUMN + KRIT_STR_COND_COLUMNCOUNT - 2)) = ""
        End With
    End If

Exit Function
doError:
    Call ERROR_EVENT("F_GET_CELL_COND_OWN")
End Function
' -------------------------------------------------------------------------------------------------------
' Процедура выцепления формулы для ячейки при режиме ввода/редактирования
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Function F_GET_CELL_FORM_OWN(ByVal LinkBar_f, ByVal LinkGraf_f, ByVal lnModeCalc As Boolean) As Variant
Dim lnLinkGraf_f, lnLinkBar_f, lnNumForm, lnLinkBar_formula As Long
Dim lcForm_c As String
Dim lSheetsForm, lSheetsAlg As Object
Dim lnCodeItog, count As Integer
Dim a, oldGraf

On Error GoTo doError
a = Array("", "", "")
count = 0

Set lSheetsForm = Sheets("FORM")
Set lSheetsAlg = Sheets("ALG")

'Очистим поля критерия
lSheetsForm.Range(lSheetsForm.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN), lSheetsForm.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + KRIT_FORM_COLUMNCOUNT - 2)) = ""
lSheetsAlg.Range(lSheetsAlg.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), lSheetsAlg.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""

lnLinkGraf_f = LinkGraf_f
lnLinkBar_f = LinkBar_f
Top:
    Select Case count
        Case Is = 0
        Case Is = 1
            oldGraf = lnLinkGraf_f
            lnLinkGraf_f = 0
        Case Is = 2
            lnLinkGraf_f = oldGraf
            lnLinkBar_f = -1 'IIf(lnModeCalc = True, 0, -1)
        Case Else
            GoTo eee
    End Select
    count = count + 1

    
    If lnModeCalc = True Then
        With lSheetsAlg
        ' Определим , а есть ли расчет через формулу для данной ячейки
            .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN).Value = lnLinkBar_f
            .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 1).Value = lnLinkGraf_f
            .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 2).Value = "<>"""""
            .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 3).Value = 0
        End With
        
        ' Проверим , а есть ли запись ( или их несколько )
        lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN).CALCULATE
        lSheetsAlg.Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN + 1).CALCULATE
        lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1).CALCULATE
        lSheetsAlg.Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN + 2).CALCULATE
        lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2).CALCULATE
        
        If lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1) = 1 Or lSheetsAlg.Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2) = 1 Then
            GoTo Top
        Else
            ' Считаем номер формулы
            lSheetsAlg.Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN).CALCULATE
            lnNumForm = lSheetsAlg.Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN)
            ' Заполним критерий отбора для формулы
            With lSheetsForm
                .Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + 2).Value = lnNumForm
                ' Проверим , а есть ли запись ( или их несколько)
                .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN).CALCULATE
                .Cells(KRIT_FORM_ROW + 3, KRIT_FORM_COLUMN + 1).CALCULATE
                .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 1).CALCULATE
                .Cells(KRIT_FORM_ROW + 3, KRIT_FORM_COLUMN + 2).CALCULATE
                .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 2).CALCULATE
                
                If .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 1) = 1 Or .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 2) = 1 Then
                    'Нет возможности считать формулу
                    F_GET_CELL_FORM_OWN = ""
                Else
                        ' Считаем LINK graf формулы в public переменную
                        .Cells(KRIT_FORM_ROW + 6, KRIT_FORM_COLUMN).CALCULATE
                        .Cells(KRIT_FORM_ROW + 7, KRIT_FORM_COLUMN).CALCULATE
                        .Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN).CALCULATE
                        
                        pnGrafLINKForFormula = .Cells(KRIT_FORM_ROW + 6, KRIT_FORM_COLUMN)
                        ' Cчитаем LINK bar формулы
                        lnLinkBar_formula = .Cells(KRIT_FORM_ROW + 7, KRIT_FORM_COLUMN)
                        ' Считаем код знака итога
                        pnCodeItogForFormula = .Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN)
                        If pnCodeItogForFormula < 4 Then ' Формула расчета(контроля со знаками '>','<') - не расчитываем
                            ' Считаем значение
                            .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN).CALCULATE
                            lcForm_c = .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN)
                            If lnLinkBar_formula = -1 Then
                                lcForm_c = Replace_in_Str(lcForm_c, "$", "")
                            End If
                            Select Case count - 1
                                Case Is = 0
                                     a(count - 1) = lcForm_c
                                Case Is = 1
                                     Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = LinkGraf_f
                                     Sheets("Service").Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN).CALCULATE
                                     a(count - 1) = Replace_in_Str(lcForm_c, "@", Sheets("Service").Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN))
                                Case Is = 2
                                     a(count - 1) = lcForm_c
                            End Select
                        Else
                            a(count - 1) = ""
                        End If
                End If
                'Очистим поля критерия
                .Range(.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN), .Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + KRIT_FORM_COLUMNCOUNT - 2)) = ""
            End With
            With lSheetsAlg
                .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
            End With
         End If
     Else 'Контроль
        With lSheetsForm
        ' Определим , а есть ли расчет через формулу для данной ячейки
            .Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN).Value = lnLinkBar_f
            .Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + 1).Value = lnLinkGraf_f
        End With
        
        ' Проверим , а есть ли запись ( или их несколько )
        lSheetsForm.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN).CALCULATE
        lSheetsForm.Cells(KRIT_FORM_ROW + 3, KRIT_FORM_COLUMN + 1).CALCULATE
        lSheetsForm.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 1).CALCULATE
        lSheetsForm.Cells(KRIT_FORM_ROW + 3, KRIT_FORM_COLUMN + 2).CALCULATE
        lSheetsForm.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 2).CALCULATE
        
        If lSheetsForm.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN + 2) = 1 Then
            GoTo Top
        Else
            ' Считаем номер формулы
            lSheetsForm.Cells(KRIT_FORM_ROW + 5, KRIT_FORM_COLUMN).CALCULATE
            lnNumForm = lSheetsForm.Cells(KRIT_FORM_ROW + 5, KRIT_FORM_COLUMN)
            With lSheetsForm
                    ' Считаем LINK graf формулы в public переменную
                    .Cells(KRIT_FORM_ROW + 6, KRIT_FORM_COLUMN).CALCULATE
                    .Cells(KRIT_FORM_ROW + 7, KRIT_FORM_COLUMN).CALCULATE
                    .Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN).CALCULATE
                    .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN).CALCULATE
                    pnGrafLINKForFormula = .Cells(KRIT_FORM_ROW + 6, KRIT_FORM_COLUMN)
                    ' Cчитаем LINK bar формулы
                    lnLinkBar_formula = .Cells(KRIT_FORM_ROW + 7, KRIT_FORM_COLUMN)
                    ' Считаем код знака итога
                    pnCodeItogForFormula = .Cells(KRIT_ALG_ROW + 3, KRIT_ALG_COLUMN)
                    ' Считаем значение
                    lcForm_c = .Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN)
                    If lnLinkBar_formula = -1 Then
                       lcForm_c = Replace_in_Str(lcForm_c, "$", "")
                    End If
                    Select Case count - 1
                       Case Is = 0
                            a(count - 1) = lcForm_c
                       Case Is = 1
                            Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = LinkGraf_f
                            Sheets("Service").Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN).CALCULATE
                            a(count - 1) = Replace_in_Str(lcForm_c, "@", Sheets("Service").Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN))
                       Case Is = 2
                            a(count - 1) = lcForm_c
                    End Select
                    'Очистим поля критерия
                    .Range(.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN), .Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + KRIT_FORM_COLUMNCOUNT - 2)) = ""
            End With
         End If
     End If
     GoTo Top
eee:
     F_GET_CELL_FORM_OWN = a

Exit Function
doError:
    Call ERROR_EVENT("F_GET_CELL_FORM_OWN")
End Function
' -------------------------------------------------------------------------------------------------------
' Вычисление суммы ячейки по условиям отбора
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub FILL_CELL_COND(ByVal lcCond_Fill As String, ByVal lcCond_Fill1 As String, ByVal lnRowCell As Integer, ByVal lnColumnCell, ByVal lnRazdel As Integer, ByVal pnZnak As Integer)
Dim lnSummaPlus, lnSummaMinus As Double
Dim lSheetsSQlData1, lSheetsReport As Object

    On Error GoTo doError
    Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    Set lSheetsSQlData1 = Sheets("SQLDATA1")

    ' запишем раздел в критерий отбора
    With lSheetsSQlData1
        .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN).Value = lnRazdel
        If VBA.Trim(lcCond_Fill1) <> "" Then
            .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN + 1).FormulaLocal = "=" + "И(" + lcCond_Fill + ";" + lcCond_Fill1 + ")"
            ' считаем сумму по условию
            .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN - 1).CALCULATE
            lnSummaPlus = .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN - 1).Value
            .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN + 1).FormulaLocal = "=" + "И(" + lcCond_Fill + "; НЕ(" + lcCond_Fill1 + "))"
            ' считаем сумму по условию
            .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN - 1).CALCULATE
            lnSummaMinus = .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN - 1).Value
        Else
            .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN + 1).FormulaLocal = "=" + lcCond_Fill
            ' считаем сумму по условию
            .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN - 1).CALCULATE
            lnSummaPlus = .Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN - 1).Value
            lnSummaMinus = 0
        End If
    End With
    ' снятие защиты
    lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
    ' Запись значения в отчет
    lSheetsReport.Cells(lnRowCell, lnColumnCell) = IIf(pnZnak = 0, lnSummaPlus - lnSummaMinus, -(lnSummaPlus - lnSummaMinus))
    ' Обнуление полей поиска по критерию
    Call CLEAR_KRIT_SQLDATA1
    Exit Sub
doError:
    Call ERROR_EVENT("FILL_CELL_COND")
End Sub
' -------------------------------------------------------------------------------------------------------
' Запись формулы контроля в ячейки вычисляемых по формуле контроля
' lcForm_Fill - текст формулы для заполнения
' NumRow - порядковый номер строки в Excel
' NumColl - порядковый номер колонки в Excel
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub FILL_CELL_FORM(ByVal lcForm_Fill As String, ByVal NumRow As Integer, ByVal NumColl As Integer)
'Заполнение ячейки формулой происходит через ячейку - посредника, чтобы сохранить относительные ссылки
' Определим букву графы
Dim lSheetsService As Object, lSheetsForm As Object, lSheetsReport As Object
Dim lcLetter_Graf

        On Error GoTo doError
        Set lSheetsService = Sheets("Service")
        Set lSheetsForm = Sheets("Form")
        Set lSheetsReport = Sheets(lSheetsService.Range("B19").Text)

        If lSheetsReport.Cells(NumRow, NumColl).Locked Then Exit Sub
        pnGrafLINKForFormula = 0
        lcLetter_Graf = letArr(lSheetsService.Range("B20")).data(NumColl - lSheetsService.Range("C6") + 1)
        lSheetsForm.Range(lcLetter_Graf + "1").FormulaLocal = "=" + lcForm_Fill
        ' снятие защиты
        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
        lSheetsReport.Cells(NumRow, NumColl).FormulaR1C1Local = lSheetsForm.Range(lcLetter_Graf + "1").FormulaR1C1Local
        ' Сброс установок
        lSheetsForm.Range(lcLetter_Graf + "1").FormulaLocal = ""
        Exit Sub
doError:
    Call ERROR_EVENT("FILL_CELL_FORM")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура заполнения ячейки
' Возвращает True - если расчет для ячейки имел место
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Function CALL_FILL_CELL(ByVal lbWhatFill As Boolean, ByVal lnCellLink As Long, ByVal lnRowCell As Long, ByVal lnColumnCell As Long) As Boolean
Dim lnRazdel, znak, columnCount, rowCount, i, page As Integer
Dim lcValue1, lcValue2, lcValue As String
Dim lSheetsReport, lSheetsService As Object

    On Error GoTo doError

    With ThisWorkbook.Sheets("Service")
        pnAddress_Row = .Range("C5")
        pnAddress_Col = .Range("C6")
        page = Sheets("Service").Range("B20")
    End With
    If algData(Sheets("Service").Range("B20")).algLoadFlag = False Then
        Application.StatusBar = "Подождите ...   Идет загрузка условий выборки и формул расчета"
        Set lSheetsService = Sheets("Service")
        columnCount = lSheetsService.Range("A10")
        rowCount = lSheetsService.Range("A9") - lSheetsService.Range("C5") + 1
    
        If letArr(page).flag = False Then
            Call readLetterData(page)
        End If
    
        Call readAlgData(page)
    End If

    Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    If lbWhatFill Then ' Расчет по условию
        If algData(page).algType(lnRowCell - pnAddress_Row, lnColumnCell - pnAddress_Col + 1) <> 0 Then
            lcValue1 = algData(page).alg1Arr(lnRowCell - pnAddress_Row, lnColumnCell - pnAddress_Col + 1)
            If lcValue1 <> "" Then
                lcValue2 = algData(page).alg2Arr(lnRowCell - pnAddress_Row, lnColumnCell - pnAddress_Col + 1)
                znak = algData(page).algZnakArr(lnRowCell - pnAddress_Row, lnColumnCell - pnAddress_Col + 1)
                ' определим раздел
                lnRazdel = letArr(page).Razdel(lnColumnCell - pnAddress_Col + 1)  'IIf(Sheets("Service").Range("B23").Value > 1, VBA.Val(VBA.Trim(VBA.str(lnColumnCell - pnAddress_Col + 1))), VBA.str(lnColumnCell - pnAddress_Col + 1))
                ' вычислим значение по условию и пропишем в ячейку
                Call FILL_CELL_COND(lcValue1, lcValue2, lnRowCell, lnColumnCell, lnRazdel, znak)
            End If
            CALL_FILL_CELL = (lcValue1 <> "")
        End If
    Else 'Расчет по формуле
         'Выцепим текст формулы
        If algData(page).formType(lnRowCell - pnAddress_Row, lnColumnCell - pnAddress_Col + 1) <> 0 Then
            CALL_FILL_CELL = False
            lcValue = algData(page).FormArr(lnRowCell - pnAddress_Row, lnColumnCell - pnAddress_Col + 1)
            If lcValue <> "" Then
                'пропишем формулу в ячейку
                Call FILL_CELL_FORM(lcValue, lnRowCell, lnColumnCell)
                CALL_FILL_CELL = True
            End If
        End If
    End If

    Exit Function
doError:
    Call ERROR_EVENT("CALL_FILL_CELL")
End Function
'-------------------------------------------------------------------------------
' ???Процедура расчета документа при загрузке
' X:\report\modules\INIT_R.bas
'-------------------------------------------------------------------------------
Public Sub CALC_ALL_REPORT()
Dim nCnt As Long, nCntCol As Long
Dim lnCountAllRow As Long, lnCountAllColumn As Long, lnColumnCell As Long
Dim lSheetsService As Object, lSheetsReport As Object, sheetsReport As Object
Dim hWnd, i, lnCellLink, lbResult, oldSheet
'pPermitDepends = True
On Error GoTo doError
ThisWorkbook.Sheets("Service").Range("A38").Value = 0

Set lSheetsService = Sheets("Service")

' Блокировка экрана
hWnd = FindWindow("XLMAIN", 0)

Application.StatusBar = "Подождите ... Идет расчет отчета"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LockWindowUpdate (hWnd)

Set oldSheet = Application.ActiveWorkbook.Sheets(lSheetsService.Range("B19").Text)
'Посмотрим а загружена ли выборка с SQLServer для расчета
If lSheetsService.Range("A25") = 0 Then
    ' Очистка Базы с выборкой
    Call CLEAR_TABLE_SQLDATA1
    ' сделаем загрузку данных
    Call GetSQLData_CALC
    lSheetsService.Range("A25") = 1
'    lSheetsReport.Select
End If

For i = 1 To lSheetsService.Range("B23")
    'проверим тип листа
    lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
    lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = lSheetsService.Range("B20")
    lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
    
    If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
        ' установим страницу
        ' зададим критерий
        lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = i
        If lSheetsService.Range("B23") = 1 Then
            
            Set sheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Range("B19").Text)
        Else
            lSheetsService.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN).CALCULATE
            Set sheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN).Text)
        End If
        sheetsReport.Activate
        
        lnCountAllRow = lSheetsService.Range("A9")
        lnCountAllColumn = lSheetsService.Range("A10")
        
        With lSheetsService
            pnAddress_Row = .Range("C5")
            pnAddress_Col = .Range("C6")
        End With
        
        For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
            lnCellLink = sheetsReport.Cells(nCnt, 1)
            If lnCellLink <> 0 Then
                For nCntCol = 1 To lnCountAllColumn
                    lnColumnCell = pnAddress_Col + nCntCol - 1
                    lbResult = CALL_FILL_CELL(True, lnCellLink, nCnt, lnColumnCell)
                    If Not lbResult Then
                        lbResult = CALL_FILL_CELL(False, lnCellLink, nCnt, lnColumnCell)
                    End If
                Next
            End If
         Next
    End If
Next
' Разблокировка экрана
oldSheet.Activate
Application.StatusBar = False
Sheets("SQLDATA1").Visible = False
Application.Calculation = xlCalculationAutomatic
LockWindowUpdate (0)
Application.ScreenUpdating = True


Exit Sub
doError:
    Call ERROR_EVENT("CALC_ALL_REPORT")
     
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура создания таблицы с условиями расчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub CreateCalcTable(Optional Razdel As Variant = 0, Optional Grafa As Variant = 0, Optional RazdelList As Variant = "", Optional linkList As Variant = "")

Dim row, i, count, lnRow1, lnColumn1, razdelCount, llRazdel As Integer
Dim SheetsOtbor As Object
Dim cSql, cStr1, cStr2, ccGrafCol, cValue As String
Dim LookRange As Range

    On Error GoTo doError
    Set SheetsOtbor = Sheets("OTBOR_COND")

   'Иницилизация глобальных переменных
    Call init_data

    On Error GoTo nnn
    If oAdoConnect Is Nothing Then
nnn:
        'ADO Соединение
        Call AdoSrvConnect
    End If

    On Error GoTo doError
   
    With Sheets("Service").Range("KRIT_RAZDEL")
        lnColumn1 = .column
        lnRow1 = .row
    End With

    With Sheets("Service")
        .Cells(lnRow1 + 1, lnColumn1) = ""
        .Cells(lnRow1 + 1, lnColumn1 + 1) = ""
        razdelCount = .Cells(lnRow1 + 8, lnColumn1)
    End With

    row = 2
    Sheets("Service").Range("B44") = ""
    If Sheets("Service").Range("B23") = 1 Then
        Sheets("Service").Range("B44") = VBA.Trim(VBA.str(Sheets("Service").Range("A10")))
    Else
        ccGrafCol = Sheets("Service").Range("S_GRAF").column
        cValue = VBA.Trim(Sheets("Service").Cells(row, ccGrafCol + 4))
        While cValue <> ""
            count = 0
            While VBA.Trim(Sheets("Service").Cells(row, ccGrafCol + 4)) = cValue
                count = count + 1
                row = row + 1
            Wend
            Sheets("Service").Range("B44") = VBA.Trim(Sheets("Service").Range("B44")) + "|" + VBA.Trim(VBA.str(count - 1))
            cValue = VBA.Trim(Sheets("Service").Cells(row, ccGrafCol + 4))
        Wend
    End If
    
    row = 2
    'Таблица с условиями расчета
    cSql = "Create Table " + VBA.Trim(Sheets("Service").Range("B43")) + " (Razdel int, Alg int, lColumn int, lRow int, Cond1 varchar(2000),Cond2 varchar(2000), code varchar(6), type int) "
    oAdoConnect.Execute ("EXECUTE A_EXEC '" + cSql + "'")
    cSql = ""
    
    While VBA.Trim(SheetsOtbor.Cells(row, 1)) <> ""
        If ((Razdel = 0) Or (Razdel = SheetsOtbor.Cells(row, 7))) And ((Grafa = 0) Or (Grafa = SheetsOtbor.Cells(row, 2)) Or SheetsOtbor.Cells(row, 2) = 0) And ((linkList = "") Or (InStr(linkList, "," + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 1))) + ",") <> 0)) And ((RazdelList = "") Or (InStr(RazdelList, VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 6)))) <> 0)) Then
            cStr1 = convertForm(SheetsOtbor.Cells(row, 8))
            cStr2 = convertForm(SheetsOtbor.Cells(row, 9))
            If (SheetsOtbor.Cells(row, 2) <> 0) Or (Grafa <> 0) Then
                If (razdelCount <= 1) Or (Sheets("Service").Range("B23") > 1) Then
                    cSql = cSql + " EXECUTE V_INSERT_IN_COND_TABLE '" + VBA.Trim(Sheets("Service").Range("B43")) + "', '" + IIf(Sheets("Service").Range("B23") = 1, "0", VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 6)))) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 7))) + "', '" + IIf(VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2))) = 0, VBA.str(Grafa), VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2)))) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 1))) + "', '" + cStr1 + "', '" + cStr2 + "','" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2))) + "'"
                Else
                    Set LookRange = Sheets("Отчет").Range("LINK").Find(SheetsOtbor.Cells(row, 1), LookIn:=xlFormulas, lookat:=xlWhole)
                    If Not LookRange Is Nothing Then
                        llRazdel = Sheets("Отчет").Cells(LookRange.row, 2)
                    End If
                    cSql = cSql + " EXECUTE V_INSERT_IN_COND_TABLE '" + VBA.Trim(Sheets("Service").Range("B43")) + "', '" + VBA.Trim(VBA.str(llRazdel)) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 7))) + "', '" + IIf(VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2))) = 0, VBA.str(Grafa), VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2)))) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 1))) + "', '" + cStr1 + "', '" + cStr2 + "','" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2))) + "'"
                End If
            Else
                'читаем раздел листа
                Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = ""
                Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 1) = ""
                Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 2) = SheetsOtbor.Cells(row, 6)
                Sheets("Service").Cells(KRIT_GRAF_ROW + 6, KRIT_GRAF_COLUMN).CALCULATE
                For i = 1 To Sheets("Service").Cells(KRIT_GRAF_ROW + 6, KRIT_GRAF_COLUMN) - 1
                    If razdelCount <= 1 Or Sheets("Service").Range("B23") > 1 Then
                        cSql = cSql + " EXECUTE V_INSERT_IN_COND_TABLE '" + VBA.Trim(Sheets("Service").Range("B43")) + "', '" + IIf(Sheets("Service").Range("B23") = 1, "0", VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 6)))) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 7))) + "', '" + VBA.Trim(VBA.str(i)) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 1))) + "', '" + cStr1 + "', '" + cStr2 + "','" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2))) + "'"
                    Else
                          Set LookRange = Sheets("Отчет").Range("LINK").Find(SheetsOtbor.Cells(row, 1), LookIn:=xlFormulas, lookat:=xlWhole)
                          If Not LookRange Is Nothing Then
                              llRazdel = Sheets("Отчет").Cells(LookRange.row, 2)
                          End If
                          cSql = cSql + " EXECUTE V_INSERT_IN_COND_TABLE '" + VBA.Trim(Sheets("Service").Range("B43")) + "', '" + VBA.Trim(VBA.str(llRazdel)) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 7))) + "', '" + VBA.Trim(VBA.str(i)) + "', '" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 1))) + "', '" + cStr1 + "', '" + cStr2 + "','" + VBA.Trim(VBA.str(SheetsOtbor.Cells(row, 2))) + "'"
                    End If
                Next
            End If
        End If
        row = row + 1
        If VBA.Len(cSql) > 5000 Then
            ' Выполняем пакет команд
            oAdoConnect.Execute (cSql)
            cSql = ""
        End If
    Wend
    If cSql <> "" Then oAdoConnect.Execute (cSql)
    Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = ""
    Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 1) = ""
    Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 2) = ""

Exit Sub
doError:
    Call ERROR_EVENT("CreateCalcTable")
End Sub
'-------------------------------------------------------------------------------
' Есть вызов в X:\app\svod_rep\v_calc_form_1.PRG
'               X:\app\svod_rep\v_inData_info.PRG
'-------------------------------------------------------------------------------
Sub calc_all_rep()
Dim lnRowCell As Integer, lnColumnCell As Integer, lnCellLink As Integer
Dim pbCondition As Boolean
Dim pnWhatCalculate As Integer, nCnt As Integer, nCntCol As Integer
Dim lnRazdel As Integer
Dim lnCountAllRow As Long, lnCountAllColumn As Long
Dim lSheetsReport As Object
Dim lSheetsService As Object
Dim lbResult As Integer
Dim lnColumn1, lnRow1, i, oldSheet

ThisWorkbook.Sheets("Service").Range("A38").Value = 0

Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
Set lSheetsService = Sheets("Service")
    With lSheetsService.Range("KRIT_RAZDEL")
         lnColumn1 = .column
         lnRow1 = .row
    End With
    Set oldSheet = Application.ActiveWorkbook.Sheets(lSheetsService.Range("B19").Text)
    For i = 1 To lSheetsService.Range("B23")
        ' установим страницу
        ' зададим критерий
        lSheetsService.Cells(lnRow1 + 1, lnColumn1) = i
        If lSheetsService.Range("B23") = 1 Then
            Set lSheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Range("B19").Text)
        Else
            lSheetsService.Cells(lnRow1 + 3, lnColumn1).CALCULATE
            Set lSheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
        End If
        lSheetsReport.Activate
        ' защита листа - снять
        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
        
        With lSheetsService
            pnAddress_Row = .Range("C5")
            pnAddress_Col = .Range("C6")
        End With
        'проверим тип листа
        lSheetsService.Range(lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 2)) = ""
        lSheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = i
        lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
        
        lnCountAllRow = Sheets("Service").Range("A9")
        lnCountAllColumn = Sheets("Service").Range("A10")
        If VBA.Val(lSheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).Text) <> 1 Then
            
            For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
                Application.StatusBar = "Строка " + VBA.Trim(VBA.str(nCnt)) + " из " + VBA.Trim(VBA.str(pnAddress_Row + lnCountAllRow + 1))
                lnCellLink = lSheetsReport.Cells(nCnt, 1)
                If lnCellLink <> 0 Then
                    For nCntCol = 1 To lnCountAllColumn
                        lnColumnCell = pnAddress_Col + nCntCol - 1
                        lbResult = CALL_FILL_CELL(False, lnCellLink, nCnt, lnColumnCell)
                    Next
                End If
            Next
            ' защита листа - поставить
            lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
        End If
    Next
    oldSheet.Activate
    Application.StatusBar = False
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура переноса данных шаблона xlt на сервер
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub UPDATE_SQL_BLANK()
Dim i, j, lnRow1, lnColumn1, sheetsService, sheetsReport, Blank, wrkCount, order, razdelCount As Integer
Dim oRecordSet As Object
Dim SqlStr, tabName, cSql As String
Dim LookRange As Range
    'Иницилизация глобальных переменных
    Call init_data
    On Error GoTo ttt
    If oAdoConnect Is Nothing Then
        Call AdoSrvConnect
    End If
    GoTo lll
ttt:
lll:

    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    
    With sheetsService.Range("KRIT_RAZDEL")
        lnColumn1 = .column
        lnRow1 = .row
    End With
    
    With sheetsService
        .Cells(lnRow1 + 1, lnColumn1) = ""
        .Cells(lnRow1 + 1, lnColumn1 + 1) = ""
        razdelCount = .Cells(lnRow1 + 8, lnColumn1)
    End With

    cSql = ""
    tabName = "##" + VBA.Trim(VBA.str(sheetsService.Range("B20"))) + VBA.Right("00000" + VBA.Val(Int(100000 * Rnd())), 5)
    SqlStr = "CREATE TABLE " + tabName + " (razdel int, bar int, code varchar(50),name varchar(254), orders int ) "
    For i = 1 To sheetsService.Range("B23")
        ' установим страницу зададим критерий
        sheetsService.Cells(lnRow1 + 1, lnColumn1) = i
        If sheetsService.Range("B23") = 1 Then
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Range("B19").Text)
        Else
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
        End If
        Blank = sheetsService.Cells(lnRow1 + 4, lnColumn1)
        sheetsReport.Activate

        If Blank <> 1 Then 'делаем обновление
            order = 1
            For j = sheetsService.Range("C5") To sheetsService.Range("A9")
                ' Проверим пакет
                If VBA.Len(SqlStr) > 6500 Then
                    ' Выполняем пакет команд
                    oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
                    SqlStr = ""
                End If
                If sheetsReport.Cells(j, 1).Value > 0 Then SqlStr = SqlStr + " INSERT " + tabName + " (razdel,bar,code,name,orders) values(" + VBA.str(IIf(sheetsService.Range("B23") <> 1, i, IIf(razdelCount <= 1, 0, VBA.str(sheetsReport.Cells(j, 2).Value)))) + ", " + VBA.str(sheetsReport.Cells(j, 1).Value) + ",''" + VBA.Trim(getFullCode(j)) + "'',''" + Replace_in_Str(Replace_in_Str(VBA.Mid(VBA.Trim(sheetsReport.Cells(j, sheetsService.Range("C6").Value - sheetsService.Range("E5").Value).Text), 1, 254), """", ""), "'", "") + "''," + VBA.str(order) + ")": order = order + 1
                If Sheets("Service").Range("B71") = 1 Then
                    If VBA.Trim(sheetsReport.Cells(j, sheetsService.Range("C6") - sheetsService.Range("E6")).Text) <> "" Then cSql = cSql + " EXEC V_UPDATE_BLANK_APP '" + VBA.Trim(Sheets("Service").Range("A15").Text) + "', 'COLUMN_DICT_KBK_ALL_CODE', " + VBA.str(IIf(sheetsService.Range("B23") <> 1, i, IIf(razdelCount <= 1, 0, VBA.str(sheetsReport.Cells(j, 2).Value)))) + ", " + VBA.str(sheetsReport.Cells(j, 1).Value) + ", '" + VBA.Trim(sheetsReport.Cells(j, sheetsService.Range("C6") - sheetsService.Range("E6")).Text) + "'"
                    If sheetsReport.Cells(j, sheetsService.Range("C6") - sheetsService.Range("E7")) = 1 Then cSql = cSql + " EXEC V_UPDATE_BLANK_APP '" + VBA.Trim(Sheets("Service").Range("A15").Text) + "', 'REFERENCE_REP_ADD_DATA', " + VBA.str(IIf(sheetsService.Range("B23") <> 1, i, IIf(razdelCount <= 1, 0, VBA.str(sheetsReport.Cells(j, 2).Value)))) + ", " + VBA.str(sheetsReport.Cells(j, 1).Value) + ", '" + VBA.Trim(sheetsReport.Cells(j, sheetsService.Range("C6") - sheetsService.Range("E7")).Text) + "'"
                End If
            Next
        End If
    Next
    If VBA.Len(SqlStr) > 0 Then
        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
        SqlStr = ""
    End If
    oAdoConnect.Execute ("EXECUTE V_UPDATE_BLANK '" + VBA.Trim(sheetsService.Range("A15").Text) + "', '" + tabName + "'")
    If VBA.Len(cSql) > 0 Then
        oAdoConnect.Execute (cSql)
        SqlStr = ""
    End If

    Set oRecordSet = CreateObject("ADODB.RecordSet")
    SqlStr = "EXECUTE A_EXEC 'SELECT [CNT]=case when isNull(dbo.GET_VAL(''" + VBA.Trim(Sheets("Service").Range("A15").Text) + "'', ''NASTR_CALC_FORM_PROC'', null), '''')<>'''' then 1 else 0 end  '"
    oRecordSet.Open SqlStr, oAdoConnect, 2, 1, 1
    If oRecordSet.Fields("CNT") > 0 Then Call UpdateFormTable
    oRecordSet.Close
    Set oRecordSet = Nothing
    On Error GoTo doError
    Exit Sub
doError:
    Call ERROR_EVENT("UPDATE_SQL_BLANK")

End Sub
' -------------------------------------------------------------------------------------------------------
' Обновление Таблиц: Алгоритм, Формулы
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub UpdateFormTable(Optional Razdel As Variant = 0, Optional Grafa As Variant = 0, Optional RazdelList As Variant = "", Optional linkList As Variant = "")
Dim sheetsAlg, SheetsFORM, oRecordSet As Object
Dim LookRange As Range
Dim lnColumn, lnRow, lnRowCount, lnOccur, lnNumRow1, lnColumn1, lnRow1, lnNumRow, lnStartAddress, lnStartEmpty As Long
Dim nCnt, typeF, iRazdel, Graf, razdelCount, i, count, bar, k, m, j, realRow, row  As Integer
Dim sumFlag As Boolean
Dim PageList() As String
Dim newBar, newGraf, resTabName, cObject, cLink, cObjLink, lRazdelName, lcPart, SqlStr, str1, str2, grafCol, Value, cCode, s, _
    lcLetter, lcZnak, lcFormText, tGraf, str, tBar As String
Dim lcFormTextWork As String

    On Error GoTo doError
    Set sheetsAlg = Sheets("ALG")
    Set SheetsFORM = Sheets("FORM")
    count = Sheets("Service").Range("B23")
    ReDim controlData(count)
    ReDim algData(count)
    ReDim letArr(count)
    'Иницилизация глобальных переменных
    Call init_data
    Sheets("Service").Range("A36") = 0

    On Error GoTo nnn
    If oAdoConnect Is Nothing Then
nnn:
        Call AdoSrvConnect
    End If
    On Error GoTo 0

    With Sheets("Service").Range("S_RAZDEL")
        lnRowCount = count
        lnRow = .row
        lnColumn = .column
    End With

    With Sheets("Service").Range("KRIT_RAZDEL")
         lnColumn1 = .column
        lnRow1 = .row
    End With

    With Sheets("Service")
        .Cells(lnRow1 + 1, lnColumn1) = ""
        .Cells(lnRow1 + 1, lnColumn1 + 1) = ""
        razdelCount = .Cells(lnRow1 + 8, lnColumn1)
    End With

    ReDim PageList(lnRowCount + 1)
    row = 1
    If Sheets("Service").Range("B23") > 1 Then
        For nCnt = lnRow + 1 To lnRow + lnRowCount
            PageList(row) = Sheets("Service").Cells(nCnt, lnColumn + 1)
            Sheets(PageList(row)).Activate
            Call readLetterData(row)
            Call readAlgData(row)
            Call readControlData(row)
            row = row + 1
        Next
    Else
        Call readLetterData(row)
        Call readAlgData(row)
        Call readControlData(row)
        PageList(row) = Application.ActiveSheet.name
    End If
    ' Определим LINK объекта отчета
    Set oRecordSet = CreateObject("ADODB.RecordSet")
    SqlStr = "EXECUTE A_EXEC 'SELECT LINK=dbo.obj_id(''" + VBA.Trim(Sheets("Service").Range("A15").Text) + "'')'"
    oRecordSet.Open SqlStr, oAdoConnect, 2, 1, 1
    cObject = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
    oRecordSet.Close
    Set oRecordSet = Nothing

    ' Определим LINK объекта "CONTROL_FORMULA"
    Set oRecordSet = CreateObject("ADODB.RecordSet")
    SqlStr = "EXECUTE A_EXEC 'SELECT LINK = dbo.obj_id(''CONTROL_FORMULA'')'"
    oRecordSet.Open SqlStr, oAdoConnect, 2, 1, 1
    cObjLink = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
    oRecordSet.Close
    Set oRecordSet = Nothing

    ' чистим старые данные
    SqlStr = "DELETE REPORT_FORM_APP WHERE LINK_UP IN(SELECT LINK FROM REPORT_FORM WHERE LINK_SELF IS NULL AND OBJECT = " + cObject + ")"
    SqlStr = SqlStr + " DELETE REPORT_FORM WHERE LINK_SELF IN(SELECT LINK FROM REPORT_FORM WHERE LINK_SELF IS NULL AND OBJECT = " + cObject + ")"
    SqlStr = SqlStr + " DELETE REPORT_FORM WHERE LINK_SELF IS NULL AND OBJECT = " + cObject
    oAdoConnect.Execute ("EXECUTE A_EXEC '" + SqlStr + "'")

    row = 1
    While row <= Sheets("Service").Range("B23")
        Sheets(PageList(row)).Activate
    
        For j = 1 To Sheets("Service").Range("A10") 'по всем колонкам
            For i = 1 To Sheets("Service").Range("A9") - Sheets("Service").Range("C5")   'по всем строкам
                Application.StatusBar = "Перенос формул: раздел '" + PageList(row) + "', графа " + VBA.Trim(VBA.str(j)) + ", строка " + VBA.Trim(VBA.str(i))
                realRow = i + Sheets("Service").Range("C5")
                bar = Sheets(PageList(row)).Cells(realRow, 1)
                Graf = j
                iRazdel = IIf(Sheets("Service").Range("B23") > 1, row, IIf(razdelCount <= 1, 0, Sheets(PageList(row)).Cells(realRow, 2)))
                lcFormTextWork = algData(row).FormArr(i, j) 'текст формулы
                If lcFormTextWork <> "" Then
                    SqlStr = "INSERT REPORT_FORM(OBJECT, RAZDEL, BAR, GRAF) VALUES(" + cObject + ", " + VBA.str(iRazdel) + ", " + VBA.str(bar) + ", " + VBA.str(Graf) + ")"
                    Set oRecordSet = CreateObject("ADODB.RecordSet")
                    oRecordSet.Open "EXECUTE A_EXEC '" + SqlStr + "'", oAdoConnect, 2, 1, 1
                    cLink = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
                    oRecordSet.Close
                    Set oRecordSet = Nothing
                    lnOccur = Occur(lcFormTextWork, "$") - Occur(lcFormTextWork, ":")
                    If lnOccur = 0 Then
                        lcFormTextWork = Replace_in_Str(lcFormTextWork, "1", "#")
                        lcFormTextWork = Replace_in_Str(lcFormTextWork, "#", "$" + VBA.Trim(VBA.str(realRow)))
                        lnOccur = Occur(lcFormTextWork, "$") - Occur(lcFormTextWork, ":")
                    End If
                    SqlStr = ""
                    lRazdelName = ""
                    For nCnt = 1 To lnOccur
                            lnStartAddress = VBA.InStr(1, lcFormTextWork, "$", vbTextCompare)
                            lnStartEmpty = VBA.InStr(lnStartAddress, lcFormTextWork, " ", vbTextCompare)
                            lcPart = VBA.Mid(lcFormTextWork, 2, lnStartEmpty - 1)
                            lcZnak = VBA.Left(lcPart, 1)
                            lnNumRow = VBA.Val(VBA.Right(lcPart, VBA.Len(lcPart) - VBA.InStr(1, lcPart, "$", vbTextCompare)))
                            iRazdel = IIf(Sheets("Service").Range("B23") > 1, row, IIf(razdelCount <= 1, 0, Sheets(PageList(row)).Cells(lnNumRow, 2)))
                            lRazdelName = ""
                            If VBA.InStr(1, lcPart, "!", vbTextCompare) <> 0 Then
                                lRazdelName = VBA.Trim(VBA.Mid(lcPart, 2, VBA.InStr(1, lcPart, "!", vbTextCompare) - 2))
                                For k = 1 To Sheets("Service").Range("B23")
                                    If PageList(k) = lRazdelName Then iRazdel = k
                                Next
                            End If
                            lcLetter = VBA.Trim(VBA.Mid(lcPart, 2, VBA.InStr(1, lcPart, "$", vbTextCompare) - 2))
                         If lRazdelName <> "" Then
                                lcLetter = VBA.Mid(lcLetter, VBA.InStr(1, lcLetter, "!", vbTextCompare) + 1)
                                Sheets(lRazdelName).Activate
                                newBar = Sheets(lRazdelName).Cells(lnNumRow, 1)
                            Else
                            newBar = Sheets(PageList(IIf(Sheets("Service").Range("B23") = 1, row, iRazdel))).Cells(lnNumRow, 1)
                            End If
                            For k = 1 To Sheets("Service").Range("A10")
                                If lcLetter = letArr(IIf(Sheets("Service").Range("B23") = 1, row, iRazdel)).data(k) Then newGraf = k: Exit For
                            Next
                         If lRazdelName <> "" Then Sheets(PageList(row)).Activate
                         SqlStr = SqlStr + " INSERT REPORT_FORM(OBJECT, RAZDEL, BAR, GRAF, ZNAK, LINK_SELF) VALUES(" + cObject + ", " + VBA.str(iRazdel) + ", " + VBA.str(newBar) + ", " + VBA.str(newGraf) + "," + IIf(lcZnak = "+", "0", "1") + ", " + cLink + ")"
                         lcFormTextWork = VBA.Right(lcFormTextWork, VBA.Len(lcFormTextWork) - VBA.Len(lcPart))
                    Next
                    If SqlStr <> "" Then oAdoConnect.Execute (SqlStr)
                        SqlStr = ""
                End If
                ' === сохранение формул ===
                For m = 1 To controlData(row).controlFormArr(i, j).count
                    lcFormTextWork = controlData(row).controlFormArr(i, j).Item(m)
                    If lcFormTextWork <> "" Then
                        SqlStr = "INSERT REPORT_FORM(OBJECT, RAZDEL, BAR, GRAF) VALUES(" + cObject + ", " + VBA.str(iRazdel) + ", " + VBA.str(bar) + ", " + VBA.str(Graf) + ")"
                        Set oRecordSet = CreateObject("ADODB.RecordSet")
                        oRecordSet.Open "EXECUTE A_EXEC '" + SqlStr + "'", oAdoConnect, 2, 1, 1
                        cLink = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
                        oRecordSet.Close
                        Set oRecordSet = Nothing
                        SqlStr = "INSERT REPORT_FORM_APP(LINK_UP, OBJECT, VALUE) VALUES(" + cLink + ", " + cObjLink + ", '" + controlData(row).controlFormNum(i, j).Item(m).Text + "|" + controlData(row).controlZnakArr(i, j).Item(m).Text + "')"
                        oAdoConnect.Execute (SqlStr)
                    
                        lnOccur = Occur(lcFormTextWork, "$") - Occur(lcFormTextWork, ":")
                        If lnOccur = 0 Then
                            lcFormTextWork = Replace_in_Str(lcFormTextWork, "1", "#")
                            lcFormTextWork = Replace_in_Str(lcFormTextWork, "#", "$" + VBA.Trim(VBA.str(realRow)))
                            lnOccur = Occur(lcFormTextWork, "$") - Occur(lcFormTextWork, ":")
                        End If
                        SqlStr = ""
                        lRazdelName = ""
                        For nCnt = 1 To lnOccur
                                iRazdel = IIf(Sheets("Service").Range("B23") > 1, row, IIf(razdelCount <= 1, 0, Sheets(PageList(row)).Cells(realRow, 2)))
                                lnStartAddress = VBA.InStr(1, lcFormTextWork, "$", vbTextCompare)
                                lnStartEmpty = VBA.InStr(lnStartAddress, lcFormTextWork, " ", vbTextCompare)
                                lcPart = VBA.Mid(lcFormTextWork, 2, lnStartEmpty - 1)
                                lcZnak = VBA.Left(lcPart, 1)
                                lnNumRow = VBA.Val(VBA.Right(lcPart, VBA.Len(lcPart) - VBA.InStr(1, lcPart, "$", vbTextCompare)))
                                iRazdel = IIf(Sheets("Service").Range("B23") > 1, row, IIf(razdelCount <= 1, 0, Sheets(PageList(row)).Cells(lnNumRow, 2)))
                                lRazdelName = ""
                                If VBA.InStr(1, lcPart, "!", vbTextCompare) <> 0 Then
                                    lRazdelName = VBA.Trim(VBA.Mid(lcPart, 2, VBA.InStr(1, lcPart, "!", vbTextCompare) - 2))
                                    For k = 1 To Sheets("Service").Range("B23")
                                        If PageList(k) = lRazdelName Then iRazdel = k
                                    Next
                                End If
                                lcLetter = VBA.Trim(VBA.Mid(lcPart, 2, VBA.InStr(1, lcPart, "$", vbTextCompare) - 2))
                                If lRazdelName <> "" Then
                                    lcLetter = VBA.Mid(lcLetter, VBA.InStr(1, lcLetter, "!", vbTextCompare) + 1)
                                    Sheets(lRazdelName).Activate
                                    newBar = Sheets(lRazdelName).Cells(lnNumRow, 1)
                                Else
                                    newBar = Sheets(PageList(IIf(Sheets("Service").Range("B23") = 1, row, iRazdel))).Cells(lnNumRow, 1)
                                End If
                                For k = 1 To Sheets("Service").Range("A10")
                                    If lcLetter = letArr(IIf(Sheets("Service").Range("B23") = 1, row, iRazdel)).data(k) Then newGraf = k: Exit For
                                Next
                                If lRazdelName <> "" Then Sheets(PageList(row)).Activate
                                SqlStr = SqlStr + " INSERT REPORT_FORM(OBJECT, RAZDEL, BAR, GRAF, ZNAK, LINK_SELF) VALUES(" + cObject + ", " + VBA.str(iRazdel) + ", " + VBA.str(newBar) + ", " + VBA.str(newGraf) + "," + IIf(lcZnak = "+", "0", "1") + ", " + cLink + ")"
                                lcFormTextWork = VBA.Right(lcFormTextWork, VBA.Len(lcFormTextWork) - VBA.Len(lcPart))
                        Next
                        If SqlStr <> "" Then oAdoConnect.Execute (SqlStr)
                        SqlStr = ""
                    End If
                Next
            Next
        Next
        row = row + 1
    Wend
Application.StatusBar = False

Exit Sub
doError:
    Call ERROR_EVENT("UpdateFormTable")
End Sub
'-------------------------------------------------------------------------------
