Attribute VB_Name = "TEMPLATE"
Option Explicit
' -------------------------------------------------------------------------------------------------------
' Процедура редактрования шаблона
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub EDIT_TEMPLATE()
Dim filename, AppName, WinName As String
    
    On Error GoTo doError
    filename = Sheets("Service").Range("A26").value
    AppName = Sheets("Service").Range("C2").value
    WinName = Sheets("Service").Range("C3").value
    pbShablon = True
    Call HideLists
    Sheets("Service").Range("A37").value = 1
    Sheets("Service").Range("A38").value = 1
    Sheets(Sheets("Service").Range("B19").Text).Visible = True
    Application.Caption = pcNameApp + AppName
    Workbooks(filename + ".xlt").Windows(1).Caption = WinName
    Call REPORT_PROTECT
    Exit Sub
doError:
    Call ERROR_EVENT("EDIT_TEMPLATE")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура сохранения шаблона
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Function SAVE_TEMPLATE() As Integer
Dim filename, i, c1, c3

    On Error GoTo doError
    If KRIT_ALG_COLUMNCOUNT = 0 Then
        Call init_data
    End If
    filename = Sheets("Service").Range("A26").value
    c1 = Null
    c3 = Null
    For Each i In Workbooks(filename + ".xlt").VBProject.VBComponents
        If (i.name = "SEEK_POP") Then
            Set c1 = i
        End If
        If (i.name = "SQLSERVER") Then
            Set c3 = i
        End If
    Next
    If Not IsNull(c1) Then Workbooks(filename + ".xlt").VBProject.VBComponents.Remove (c1)
    If Not IsNull(c3) Then Workbooks(filename + ".xlt").VBProject.VBComponents.Remove (c3)
    Workbooks(filename + ".xlt").Save
    Workbooks(filename + ".xlt").Saved = True
    If Not IsNull(c1) Then Workbooks(filename + ".xlt").VBProject.VBComponents.Import (Workbooks(filename + ".xlt").Sheets("Service").Range("A33").Text + "seek_pop.frm")
    If Not IsNull(c3) Then Workbooks(filename + ".xlt").VBProject.VBComponents.Import (Workbooks(filename + ".xlt").Sheets("Service").Range("A33").Text + "sqlServer.bas")
Exit Function
doError:
    Call ERROR_EVENT("SAVE_TEMPLATE")
End Function
' -------------------------------------------------------------------------------------------------------
' Выход из шаблона
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub EXIT_TEMPLATE()
Dim filename As String, lnRes As Long

On Error GoTo doError
filename = Sheets("Service").Range("A26").value
If pbShablon And Not Workbooks(filename + ".xlt").Saved Then
    lnRes = MsgBox("Сохранить бланк отчета ?", vbQuestion + vbYesNoCancel, pcNameApp + "Сохранение бланка отчета")
    If lnRes = vbYes Then
        Workbooks(filename + ".xlt").Sheets(Sheets("Service").Range("B19").Text).Range("MAIN_DATA") = ""
        Workbooks(filename + ".xlt").Windows(1).ScrollRow = 1
        Workbooks(filename + ".xlt").Save
    End If
    If lnRes = vbNo Then
        Workbooks(filename + ".xlt").Saved = True
    End If
    If lnRes = vbCancel Then
        Exit Sub
    End If
End If
Workbooks(1).Saved = True
Call MENU_DELETE
Call TOOLBAR_DELETE("Редактор")
Exit Sub
doError:
    Call ERROR_EVENT("EXIT_TEMPLATE")
    Application.Quit
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура добавления строки в шаблон
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub ADDSTRING()
Dim lnRowAllCount, lnColumnAllCount As Long
Dim lSheetsService, lSheetsReport As Object
Dim lcprivName, lcprivCode, shablon, lnprivRazdel As String
Dim count, i, first As Integer

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

    If KRIT_ALG_COLUMNCOUNT = 0 Then
        Call init_data
    End If
    pnAddress_Row = Sheets("Service").Range("C5")   'начало заполнения листа отчета - с какой записи
    pnAddress_Col = Sheets("Service").Range("C6")   'с какой колонки
    lnRowAllCount = lSheetsService.Range("A9")
    lnColumnAllCount = lSheetsService.Range("A10")
    ' если ячейка попадает в строковый ранг
    If ActiveCell.row >= pnAddress_Row And ActiveCell.row <= lnRowAllCount + pnAddress_Row Then
        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False  'снять защиту
        lSheetsReport.Cells(ActiveCell.row, 1).EntireRow.Insert 'вставляем строку
        lSheetsReport.Cells(ActiveCell.row, 1).RowHeight = lSheetsReport.Cells(ActiveCell.row + 1, 1).RowHeight
        lSheetsReport.Cells(ActiveCell.row, 2) = lSheetsReport.Cells(ActiveCell.row + 1, 2)
        lSheetsService.Range("A9").value = lSheetsService.Range("A9").value + 1
        lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E2")).value = lSheetsReport.Range("A1").value + 1
        Call EDITSTRING
        If Not pbFormCancel Then
        lSheetsReport.Cells(ActiveCell.row, 1).EntireRow.Delete
        Else
            'Необходимо исправить адреса ячеек используемых в формулах
            Call READDRESS_FORMULA(ActiveCell.row, True)
        End If
    End If
    Exit Sub
doError:
    Call ERROR_EVENT("ADDSTRING")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура удаления строки в шаблон
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub DELETESTRING(Optional msg As Boolean = True)
Dim lnLinkBar, lnRow, lnRes As Long
Dim lSheetsReport, lSheetsService As Object
    
    Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    Set lSheetsService = Sheets("Service")
    On Error GoTo doError
    pnAddress_Row = Sheets("Service").Range("C5")   'начало заполнения листа отчета - с какой записи
    pnAddress_Col = Sheets("Service").Range("C6")   'с какой колонки
    If KRIT_ALG_COLUMNCOUNT = 0 Then
        Call init_data
    End If
    ' если ячейка попадает в ранг
    If ActiveCell.row >= pnAddress_Row And ActiveCell.row <= lSheetsService.Range("A9") + pnAddress_Row Then
     If lSheetsService.Range("A9") - lSheetsService.Range("C5") > 1 Then
        If msg Then
            lnRes = MsgBox("Вы действительно хотите удалить строку?", vbYesNo + vbExclamation, pcNameApp + "Внимание")
        Else
            lnRes = 6
        End If
        If lnRes = 6 Then
            Application.ScreenUpdating = False
            Application.StatusBar = "Подождите ... Идет редактирование формул "
            Sheets("Service").Range("A37").value = 1
            With lSheetsReport
                'снять защиту
                .Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                lnRow = ActiveCell.row
                lnLinkBar = .Cells(lnRow, pnAddress_Col - lSheetsService.Range("E2"))
                .Cells(lnRow, 1).EntireRow.Delete
                lSheetsService.Range("A9").value = lSheetsService.Range("A9").value - 1
                ' Вызов процедуры удаления формул
                Call READDRESS_FORMULA(lnRow, False)
                ' Теперь надо удалить все, что относится к этой строке
                Call DELETE_ALL_STRING(lnLinkBar)
                ' Установить защиту
                .Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
            End With
            Application.ScreenUpdating = True
            Application.StatusBar = False
        End If
     Else
        Call MsgBox("Нельзя удалить все строки документа !", vbOKOnly, pcNameApp + "Внимание")
     End If
    End If
    Exit Sub
doError:
    Call ERROR_EVENT("DELETESTRING")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура редактирования строки в шаблоне
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub EDITSTRING()
Dim lnRowAllCount, lnColumnAllCount As Long
Dim lSheetsService, lSheetsReport As Object
Dim shablon As String
Dim count, i, first As Integer

    On Error GoTo doError
    Set lSheetsService = Sheets("Service")
    Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    If KRIT_ALG_COLUMNCOUNT = 0 Then
        Call init_data
    End If
    pnAddress_Row = Sheets("Service").Range("C5")   'начало заполнения листа отчета - с какой записи
    pnAddress_Col = Sheets("Service").Range("C6")   'с какой колонки
    lnRowAllCount = lSheetsService.Range("A9")
    lnColumnAllCount = lSheetsService.Range("A10")
    ' если ячейка попадает в ранг
    If ActiveCell.row >= pnAddress_Row And ActiveCell.row <= lnRowAllCount + pnAddress_Row Then
        Load ADDSTR_FORM
        With ADDSTR_FORM
            If lSheetsService.Range("E5") <> 0 Then
                .privName = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E5"))
                .strName = lSheetsService.Range("D5").Text
                .enablName = True
            Else
                .enablName = False
            End If
        If lSheetsService.Range("E7") <> 0 Then
            .Label5.Visible = True
            .Label5.Caption = lSheetsService.Range("D7").Text
            .TextBox4.Visible = True
            .TextBox4.Text = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E7"))
        End If
        If lSheetsService.Range("E8") <> 0 Then
            .Label6.Visible = True
            .Label6.Caption = lSheetsService.Range("D8").Text
            .TextBox5.Visible = True
            .TextBox5.Text = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E8"))
        End If
        If lSheetsService.Range("E9") <> 0 Then
            .Label7.Visible = True
            .Label7.Caption = lSheetsService.Range("D9").Text
            .TextBox6.Visible = True
            .TextBox6.Text = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E9"))
        End If
        If lSheetsService.Range("E6") <> 0 Then
            .privCode = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E6"))
            .strCode = lSheetsService.Range("D6").Text
            .enablCode = True
        Else
            .enablCode = False
        End If
        If lSheetsService.Range("E4") <> 0 Then
            If lSheetsService.Range("B22") = 1 Then
                .privBK = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4"))
            Else
                .privBK = ""
                For i = 0 To lSheetsService.Range("B22") - 1
                    .privBK = .privBK + lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4") + i)
                Next
            End If
            .strBK = lSheetsService.Range("D4").Text
            .enablBK = True
        Else
            .enablBK = False
        End If
        If lSheetsService.Range("E3") <> 0 Then
            .privRazdel = lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E3"))
            .strRazdel = lSheetsService.Range("D3").Text
            .enablRazdel = True
        Else
            .enablRazdel = False
        End If
        Call SET_CELLS(True, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4")), .TextBox3)
        Call SET_CELLS(True, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E5")), .TextBox1)
        Call SET_CELLS(True, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E6")), .TextBox2)
        .Show
    End With
    If pbFormCancel Then 'перезаписываем строку
        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False  'снять защиту
        With ADDSTR_FORM    'пропишем атрибуты строки
            If .enablBK Then    'Код Бк
                If lSheetsService.Range("B22") = 1 Then
                    Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4")), .TextBox3)
                    lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4")).value = .privBK
                Else
                    shablon = lSheetsService.Range("B21").Text
                    count = 0
                    For i = 1 To VBA.Len(shablon)
                        count = count + VBA.Val(VBA.Mid(shablon, i, 1))
                    Next
                    If count > VBA.Len(.privBK) Then
                        .privBK = .privBK + VBA.String(count - VBA.Len(.privBK), "0")
                    End If
                    first = 1
                    For i = 0 To lSheetsService.Range("B22") - 1
                        Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4") + i), .TextBox3)
                        
                        lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E4") + i).value = VBA.Mid(.privBK, first, VBA.Val(VBA.Mid(shablon, i + 1, 1)))
                        first = first + VBA.Val(VBA.Mid(shablon, i + 1, 1))
                    Next
                End If
            End If
            ' Наименование показателя
            If .enablName Then
               Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E5")), .TextBox1)
               lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E5")).value = .privName
            End If
            ' Код строки
            If .enablCode Then
               Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E6")), .TextBox2)
               lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E6")).value = .privCode
            End If
            ' Посмотрим в какой раздел мы попали и проставим его
            If .enablRazdel Then
                If lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E3")) = "" Then
                    lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E3")).value = .privRazdel
                End If
            End If
            If .TextBox4.Visible = True Then
                Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E7")), .TextBox4)
                lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E7")).value = .TextBox4.Text
            End If
            If .TextBox5.Visible = True Then
                Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E8")), .TextBox5)
                lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E8")).value = .TextBox5.Text
            End If
            If .TextBox5.Visible = True Then
                Call SET_CELLS(False, lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E9")), .TextBox6)
                lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E9")).value = .TextBox6.Text
            End If
        End With
        Unload ADDSTR_FORM
        lSheetsReport.Rows(ActiveCell.row).AutoFit 'автоподбор высоты ячейки
        'поставить защиту
        lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    End If
    End If
    Exit Sub
doError:
    Call ERROR_EVENT("EDITSTRING")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура ввода/редактирования алгоритма расчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub ALG_CALCULATE()
Dim lnCurRow, lnCurColumn, lnLinkStr, lnTypeAlg As Integer

    On Error GoTo doError
    If KRIT_ALG_COLUMNCOUNT = 0 Then
        Call init_data
    End If
    pnAddress_Row = Sheets("Service").Range("C5")   'начало заполнения листа отчета - с какой записи
    pnAddress_Col = Sheets("Service").Range("C6")   'с какой колонки
    Sheets(Sheets("Service").Range("B19").Text).Activate
    lnCurRow = ActiveCell.row
    lnCurColumn = ActiveCell.column
    ' Проверим попадает ли выбранная ячейка в виртуальное поле ввода
    If (lnCurRow >= pnAddress_Row And lnCurRow <= Application.ActiveWorkbook.Sheets("Service").Range("A9") + pnAddress_Row) And _
                    (lnCurColumn >= pnAddress_Col And lnCurColumn <= Application.ActiveWorkbook.Sheets("Service").Range("A10") + pnAddress_Col) Then
        'Определим Link строки
        lnLinkStr = Range("A" + VBA.Trim(VBA.str(lnCurRow))).value
        If lnLinkStr = 0 Then ' Это не значимая графа
            Exit Sub
        End If
        'Загрузка формы выбора алгоритма расчета
        CHOOSE_ALG.Show
        If pbFormCancel Then
            ' Загрузка формы редактирования алгоритма расчета
            lnTypeAlg = CHOOSE_ALG.pnTypeAlg
            Unload CHOOSE_ALG
            Load ALG_EDIT
            With ALG_EDIT
                .pnLinkStr = lnLinkStr
                .pnRowStr = lnCurRow
                .pnColumnStr = lnCurColumn
                .pnTypeAlg = lnTypeAlg
                .Form_init
                .Show
            End With
            Unload ALG_EDIT
        End If
    End If

Exit Sub
doError:
    Call ERROR_EVENT("ALG_CALCULATE")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура вызова редактора формул
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub LISTS_FORMULA()
    On Error GoTo doError
    If KRIT_ALG_COLUMNCOUNT = 0 Then
        Call init_data
    End If
    Load LIST_FORMULA
    With LIST_FORMULA
        .pnMode = 0
        .Form_init
        .Show
    End With
    Exit Sub
doError:
    Call ERROR_EVENT("LISTS_FORMULA")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура установки в ячееки
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub SET_CELLS(ByVal lbMode As Boolean, ByVal lRangeCell As Excel.Range, ByVal loForm As Object)

On Error GoTo doError
If lbMode Then ' установка на форме
    With lRangeCell
        loForm.Font.name = .Font.name
        loForm.Tag = .Font.size
        loForm.Font.Italic = .Font.Italic
        loForm.Font.Underline = IIf(.Font.Underline = xlUnderlineStyleNone, False, True)
        loForm.Font.Strikethrough = .Font.Strikethrough
        loForm.Font.Bold = IIf(IsNull(.Font.Bold), False, .Font.Bold)
        loForm.ForeColor = .Font.Color
    End With
Else ' установка ячеек
    With lRangeCell
        .NumberFormat = "@"
        .Font.name = loForm.Font.name
        .Font.size = loForm.Tag
        .Font.Italic = loForm.Font.Italic
        .Font.Underline = loForm.Font.Underline
        .Font.Strikethrough = loForm.Font.Strikethrough
        .Font.Bold = IIf(IsNull(loForm.Font.Bold), False, loForm.Font.Bold)
        .Font.Color = loForm.ForeColor
    End With
End If
Exit Sub
doError:
    Call ERROR_EVENT("SET_CELLS")
End Sub
' -------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub WORK_ERR()
Dim lcErr As String
Dim lw As Workbook
lcErr = "Ошибка : " + VBA.Trim(VBA.str(err.Number)) + vbNewLine + err.Description
MsgBox lcErr, vbCritical + vbOKOnly, "Внимание"
For Each lw In Workbooks
    lw.Saved = True
Next lw
Application.Quit
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура записи , модификации , удаления из TABLE_ALG
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub WORK_TABLE_ALG(ByVal lnLinkBar As Long, ByVal lnLinkGraf As Long, ByVal lnNumFormula As Long, ByVal lcNumNewFormula As String, ByVal lnVidOldAlg As Long, ByVal lnFlagOperation As Integer)
Dim lnColumn, lnColumnCount, lnRowDelete, lnRow As Long
Dim lSheets As Object
Dim lRange, LookRange As Range

    On Error GoTo doError
    Set lSheets = Sheets("ALG")
    If lnFlagOperation <> 1 Then
        Set lRange = lSheets.Range("KRIT_ALG")
        lnColumn = lRange.column
        lnColumnCount = lRange.Columns.count
        lnRow = lRange.row
        ' Определим номер
        lSheets.Cells(lnRow + 1, lnColumn) = lnLinkBar
        lSheets.Cells(lnRow + 1, lnColumn + 1) = lnLinkGraf
        If lnVidOldAlg = 1 Then ' По условию
            lSheets.Cells(lnRow + 1, lnColumn + 3) = 1
        Else ' По формуле
            lSheets.Cells(lnRow + 1, lnColumn + 2) = lnNumFormula ' Старая формула
        End If
        lnRowDelete = lSheets.Cells(lnRow + 4, lnColumn)
        ' Обнуление критерия поиска
        lSheets.Range(lSheets.Cells(lnRow + 1, lnColumn), lSheets.Cells(lnRow + 1, lnColumn + lnColumnCount - 2)) = ""
    End If
    Set lRange = lSheets.Range("TABLE_ALG")
    lnColumn = lRange.column
    lnColumnCount = lRange.Columns.count
                
    Select Case lnFlagOperation
    Case 1 ' Insert
        Set LookRange = lSheets.Columns(lnColumn).Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
        lnRowDelete = LookRange.row
        'Сам Insert
        lSheets.Cells(lnRowDelete, lnColumn) = lnLinkBar
        lSheets.Cells(lnRowDelete, lnColumn + 1) = lnLinkGraf
        lSheets.Cells(lnRowDelete, lnColumn + 2) = IIf(lcNumNewFormula = "", "", VBA.Val(lcNumNewFormula))
        lSheets.Cells(lnRowDelete, lnColumn + 3) = IIf(lcNumNewFormula = "", 1, 0)
        lSheets.Cells(lnRowDelete, lnColumn + 4).FormulaLocal = "= СТРОКА()"
        lSheets.Cells(lnRowDelete, lnColumn + 5) = Sheets("Service").Range("B20")
    Case 2 ' Update
        lSheets.Cells(lnRowDelete, lnColumn + 2) = IIf(lcNumNewFormula = "", "", VBA.Val(lcNumNewFormula))
        lSheets.Cells(lnRowDelete, lnColumn + 3) = IIf(lcNumNewFormula = "", 1, 0)
    
    Case 3 ' Delete
        lSheets.Range(lSheets.Cells(lnRowDelete, lnColumn), lSheets.Cells(lnRowDelete, lnColumn + lnColumnCount - 1)).Delete Shift:=xlUp
    End Select

Exit Sub
doError:
    Call ERROR_EVENT("WORK_TABLE_ALG")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура удаления из TABLE_STR_COND
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Function WORK_TABLE_STR_COND(ByVal lnLinkBar As Long, ByVal lnLinkGraf As Long, ByVal lnLinkAlg As Long, ByVal lnFlagOperation As Integer, ByVal lcFormulaText1 As String, ByVal lcFormulaText2 As String, ByVal znak As Integer, txt1 As String, txt2 As String) As Long
Dim lnColumn, lnColumnCount, lnRow, lnRowValue, lnValueColumnCount, lnColumnValue, lnRowDelete As Long
Dim lSheets As Object
Dim lRange As Range, LookRange As Range

    On Error GoTo doError
    Set lSheets = Sheets("OTBOR_COND")
    If lnFlagOperation < 3 Then
        lnColumn = lSheets.Range("TABLE_STR_COND").column
        lnRowValue = lSheets.Range("KRIT_STR_COND").row
        lnColumnValue = lSheets.Range("KRIT_STR_COND").column
        lnValueColumnCount = lSheets.Range("KRIT_STR_COND").Columns.count
    End If
    Select Case lnFlagOperation
        Case 1 ' Insert
            Set LookRange = lSheets.Columns(lnColumn).Find("", LookIn:=xlFormulas, SearchOrder:=xlByRows)
            lnRow = LookRange.row
            lSheets.Cells(lnRow, lnColumn) = lnLinkBar
            lSheets.Cells(lnRow, lnColumn + 1) = lnLinkGraf
            lSheets.Cells(lnRow, lnColumn + 2).FormulaLocal = "=СТРОКА()"
            lSheets.Cells(lnRow, lnColumn + 3) = lcFormulaText1
            lSheets.Cells(lnRow, lnColumn + 4) = lcFormulaText2
            lSheets.Cells(lnRow, lnColumn + 5) = Sheets("Service").Range("B20")
            lSheets.Cells(lnRow, lnColumn + 6) = znak
            lSheets.Cells(lnRow, lnColumn + 7) = txt1
            lSheets.Cells(lnRow, lnColumn + 8) = txt2
            WORK_TABLE_STR_COND = lSheets.Cells(lnRow, lnColumn + 2)
        Case 2 'Update строки с формулой Excel
            'Наити запись для Update
            lSheets.Cells(lnRowValue + 1, lnColumnValue) = lnLinkBar
            lSheets.Cells(lnRowValue + 1, lnColumnValue + 1) = lnLinkGraf
            ' Считаем номер записи
            lnRow = lSheets.Cells(lnRowValue + 4, lnColumnValue)
            'Сделаем Update
            lSheets.Cells(lnRow, lnColumn + 3) = lcFormulaText1
            lSheets.Cells(lnRow, lnColumn + 4) = lcFormulaText2
            lSheets.Cells(lnRow, lnColumn + 6) = znak
            lSheets.Cells(lnRow, lnColumn + 7) = txt1
            lSheets.Cells(lnRow, lnColumn + 8) = txt2
            'Обнуление критерия
            lSheets.Range(lSheets.Cells(lnRowValue + 1, lnColumnValue), lSheets.Cells(lnRowValue + 1, lnColumnValue + lnValueColumnCount - 2)) = ""
        Case 3 ' Delete
            'Заполним критерий для получения записи удаления
            Set lRange = lSheets.Range("KRIT_STR_COND")
            ' Адресс критерия
            lnColumn = lRange.column
            lnColumnCount = lRange.Columns.count
            lnRow = lRange.row
            lSheets.Cells(lnRow + 1, lnColumn) = lnLinkBar
            lSheets.Cells(lnRow + 1, lnColumn + 1) = lnLinkGraf
            'lSheets.Cells(lnRow + 1, lnColumn + 2) = lnLinkAlg
            lnRowDelete = lSheets.Cells(lnRow + 4, lnColumn)
            'Обнуление критерия
            lSheets.Range(lSheets.Cells(lnRow + 1, lnColumn), lSheets.Cells(lnRow + 1, lnColumn + lnColumnCount - 2)) = ""
            'Удаляем из TABLE_STR_COND
            lnColumn = lSheets.Range("TABLE_STR_COND").column
            lnColumnCount = lSheets.Range("TABLE_STR_COND").Columns.count
            lSheets.Range(lSheets.Cells(lnRowDelete, lnColumn), lSheets.Cells(lnRowDelete, lnColumn + lnColumnCount - 1)).Delete Shift:=xlUp
            WORK_TABLE_STR_COND = 0
    End Select

Exit Function
doError:
    Call ERROR_EVENT("WORK_TABLE_STR_COND")
End Function
' -------------------------------------------------------------------------------------------------------
' Процедура записи и удаления из TABLE_PART_COND
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub WORK_TABLE_PART_COND(ByVal lnLinkAlg As Long, ByVal lnFlagOperation As Integer, lListView As Object)
Dim lnColumn, lnColumnCount, lnRowDelete, lnRow, lnRowFirst, nCnt As Long
Dim lcFirstAddress As String
Dim lSheets As Object
Dim lRange, LookRange As Range


    On Error GoTo doError
    Set lSheets = Sheets("OTBOR_COND")
    Set lRange = lSheets.Range("TABLE_PART_COND")
    lnColumn = lRange.column
    lnColumnCount = lRange.Columns.count
    Select Case lnFlagOperation
    Case 1 ' Insert
        ' Находим свободную запись
        Set LookRange = lSheets.Columns(lnColumn).Find("", LookIn:=xlValues, SearchOrder:=xlByRows)
        lnRow = LookRange.row
        
        For nCnt = 1 To lListView.ListItems.count
                lSheets.Cells(lnRow, lnColumn) = lnLinkAlg
                lSheets.Cells(lnRow, lnColumn + 1) = IIf(lListView.ListItems(nCnt).SubItems(1) = "", "", lListView.ListItems(nCnt).Text)
                lSheets.Cells(lnRow, lnColumn + 2) = IIf(lListView.ListItems(nCnt).SubItems(1) = "", lListView.ListItems(nCnt).Text, lListView.ListItems(nCnt).SubItems(1))
                lSheets.Cells(lnRow, lnColumn + 3) = lListView.ListItems(nCnt).SubItems(2)
                lSheets.Cells(lnRow, lnColumn + 4) = Sheets("Service").Range("B20")
            lnRow = lnRow + 1
        Next

    Case 2 ' Update
            ' Пока нет , т.к. при обновлении записи сначала удаляются а затем вставляются через Insert
    Case 3 ' Delete
        'Просканируем TABLE_PART_COND и определим кол-во записей для удаления
        Set LookRange = lSheets.Columns(lnColumn).Find(lnLinkAlg, LookIn:=xlValues)
        lnRowDelete = 0
        If Not LookRange Is Nothing Then
            lcFirstAddress = LookRange.Address
            lnRowFirst = LookRange.row
            Do
                lnRowDelete = lnRowDelete + 1
                Set LookRange = lSheets.Columns(lnColumn).FindNext(LookRange)
            Loop While Not LookRange Is Nothing And LookRange.Address <> lcFirstAddress
        End If
        For nCnt = 1 To lnRowDelete ' Удаление строк таблицы
            lSheets.Range(lSheets.Cells(lnRowFirst, lnColumn), lSheets.Cells(lnRowFirst, lnColumn + lnColumnCount - 1)).Delete Shift:=xlUp
        Next
    End Select

Exit Sub
doError:
    Call ERROR_EVENT("WORK_TABLE_PART_COND")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура удаления всего, что относится к удаляемой строке
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub DELETE_ALL_STRING(ByVal lnLinkBar As Long)
Dim lSheetsAlg, lSheetsService, lSheetsCond, lSheetsForm As Worksheet
Dim lnColumn, lnColumnCount, lnRow, nCnt, lnColumn1, lnColumnCount1, lnRow1 As Long
Dim lnVidAlg, lnNumFormula, lnLinkAlg, row As Integer
Dim LookRange As Range
Dim i As String

On Error GoTo doError

' Посмотрим есть алгоритм расчета для данной строки
Set lSheetsAlg = Sheets("ALG")
Set lSheetsService = Sheets("Service")
Set lSheetsCond = Sheets("OTBOR_COND")
Set lSheetsForm = Sheets("FORM")
'lSheetsForm.Visible = True

With lSheetsAlg.Range("KRIT_ALG")
    lnColumn = .column
    lnColumnCount = .Columns.count
    lnRow = .row
End With
With lSheetsCond.Range("KRIT_STR_COND")
    lnColumn1 = .column
    lnColumnCount1 = .Columns.count
    lnRow1 = .row
End With
For nCnt = 0 To lSheetsService.Range("A10")
    ' TABLE_ALG
    'Заполнение критерия
    With lSheetsAlg
        .Cells(lnRow + 1, lnColumn) = lnLinkBar
        .Cells(lnRow + 1, lnColumn + 1) = nCnt
        If .Cells(lnRow + 2, lnColumn + 1) = 0 And .Cells(lnRow + 2, lnColumn + 2) = 0 Then 'Запись есть
            ' Определим на что настроено
            If .Cells(lnRow + 2, lnColumn) = 1 Then ' по условию
                lnVidAlg = 1
            Else ' по формуле
                lnVidAlg = 0
                lnNumFormula = .Cells(lnRow + 3, lnColumn)
            End If
            ' Вызываем процедуру удаления из TABLE_ALG
            Call WORK_TABLE_ALG(lnLinkBar, nCnt, lnNumFormula, "", lnVidAlg, 3)
        End If
    End With
    With lSheetsCond
        ' заполняем критерий
        .Cells(lnRow1 + 1, lnColumn1) = lnLinkBar
        .Cells(lnRow1 + 1, lnColumn1 + 1) = nCnt
        If .Cells(lnRow1 + 2, lnColumn1 + 1) = 0 And .Cells(lnRow1 + 2, lnColumn1 + 2) = 0 Then ' Запись есть
            lnLinkAlg = .Cells(lnRow1 + 2, lnColumn1)
            ' Вызываем удаление из TABLE_STR_COND
            Call WORK_TABLE_STR_COND(lnLinkBar, nCnt, lnLinkAlg, 3, "", "", 0, "", "")
        End If
    End With
Next
' Обнуление критериев
lSheetsCond.Range(lSheetsCond.Cells(lnRow1 + 1, lnColumn1), lSheetsCond.Cells(lnRow1 + 1, lnColumn1 + lnColumnCount1 - 2)) = ""
lSheetsAlg.Range(lSheetsAlg.Cells(lnRow + 1, lnColumn), lSheetsAlg.Cells(lnRow + 1, lnColumn + lnColumnCount - 2)) = ""
' TABLE_FORM - здесь сложнее - может быть несколько записей по одному адресу
' удаляем все у кого LINK_BAR = lnLinkBar
With lSheetsForm
    lnColumn = .Range("TABLE_FORM").column
    lnColumnCount = .Range("TABLE_FORM").Columns.count
    Set LookRange = .Columns(lnColumn).Find(lnLinkBar, LookIn:=xlValues, lookat:=xlWhole)
    If Not LookRange Is Nothing Then
        i = LookRange.Address
        While Not LookRange Is Nothing
            If .Cells(LookRange.row, lnColumn + 7) = lSheetsService.Range("B20") Then
                row = LookRange.row
                If i = LookRange.Address Then i = ""
                .Range(.Cells(LookRange.row, lnColumn), .Cells(LookRange.row, lnColumn + lnColumnCount - 1)).Delete Shift:=xlUp
                Set LookRange = .Cells(row - 1, lnColumn)
            End If
            Set LookRange = .Columns(lnColumn).FindNext(LookRange)
            If Not LookRange Is Nothing Then
                If i = "" Then
                    i = LookRange.Address
                Else
                    If i = LookRange.Address Then Set LookRange = Nothing
                End If
            End If
        Wend
    End If
End With

Exit Sub
doError:
    Call ERROR_EVENT("DELETE_ALL_STRING")
End Sub
' -------------------------------------------------------------------------------------------------------
' Обновление серверной части шаблона
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub UPDATE_SQL_TEMPLATE()
Dim i, lnRow1, lnColumn1, j, Blank, order, razdelCount, wrkCount As Integer
Dim oRecordSet As Object
Dim sheetsService, sheetsReport As Object
Dim cSql, cSql1, tabName As String
Dim LookRange As Range
    'Иницилизация переменных
    Call init_data
    On Error GoTo doError
    If oAdoConnect Is Nothing Then
        Call AdoSrvConnect
    End If

    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
    'Stop
    Application.StatusBar = "Подождите.... Идет перенос информации о структуре шаблона..... "
    tabName = "##" + VBA.Trim(VBA.str(sheetsService.Range("A20"))) + VBA.Right("00000" + VBA.Val(VBA.Int(100000 * VBA.Rnd())), 5)
    cSql1 = ""
    cSql = "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(cSql) > 6500 Then
                oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
                cSql = ""
            End If
            If sheetsReport.Cells(j, 1).value > 0 Then cSql = cSql + " 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 cSql1 = cSql1 + " 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 cSql1 = cSql1 + " 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(cSql) > 0 Then
    oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
    cSql = ""
End If
oAdoConnect.Execute ("EXECUTE V_UPDATE_BLANK '" + VBA.Trim(sheetsService.Range("A15").Text) + "', '" + tabName + "'")

If VBA.Len(cSql1) > 0 Then
    oAdoConnect.Execute (cSql1)
    cSql1 = ""
End If

Set oRecordSet = CreateObject("ADODB.RecordSet")
cSql = "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 cSql, oAdoConnect, 2, 1, 1
If oRecordSet.Fields("CNT") > 0 Then Call UpdateFormTable
oRecordSet.Close
Set oRecordSet = Nothing
Application.StatusBar = "Подождите.... Идет перенос условий расчета..... "
Call createCalcTable
Application.StatusBar = False
Call MsgBox("Обновление успешно завершено !!!", 64, "Обновление шаблона")
On Error GoTo doError
Exit Sub
doError:
    Call ERROR_EVENT("UPDATE_SQL_TEMPLATE")

End Sub
' -------------------------------------------------------------------------------------------------------
' Обновление условий расчета из шаблона
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub UPDATE_COND()
Dim xfileName, oldPageName, lCode, cond1New, cond2New As String
Dim cond1 As String
Dim cond2 As String
Dim NewWorkBook, OldWorkBook As Workbook
Dim i, rowAlg, razdelCount, lRazdel, lGraf, lZnak, newStrNum, newStrLink, lZnakNew As Integer
Dim lnColumn, lnRow, lnRowCount As Long, lnColumnAlg, lnRowAlg, lnRowCountAlg, lnColumnCountAlg As Long
Dim lnColumnCond, lnRowCond, lnRowCountCond, lnColumnCountCond, nCnt, lLinkStr As Long
Dim lSheets As Object
Dim RazdelList() As String
Dim lFlag As Boolean

    xfileName = GetFileFromAPI("", "xlt", 1)
    If xfileName = "" Then
        Exit Sub
    End If
    Set NewWorkBook = Application.ActiveWorkbook
    Set OldWorkBook = Application.Workbooks.Open(xfileName)
    rowAlg = 2
    Open "c:\update_alg.txt" For Output As #1
    Print #1, "Обновлене условий расчета " + VBA.Format(VBA.Date, "dd.mm.yyyy")
    
    Set lSheets = OldWorkBook.Sheets("Service")
    With lSheets.Range("S_RAZDEL")
        lnRowCount = .Rows.count
        lnRow = .row
        lnColumn = .column
    End With
    razdelCount = lSheets.Range("B23").value
    
    If razdelCount > 1 Then
        ReDim RazdelList(razdelCount)
        For i = lnRow + 1 To lnRow + razdelCount
            RazdelList(i - lnRow) = lSheets.Cells(i, lnColumn + 1)
        Next
    Else
        ReDim RazdelList(1)
        RazdelList(1) = OldWorkBook.ActiveSheet.name
    End If
    
    With OldWorkBook.Sheets("OTBOR_COND").Range("KRIT_STR_COND")
        lnRowCount = .Rows.count
        lnRow = .row
        lnColumn = .column
    End With
    
    With NewWorkBook.Sheets("ALG").Range("KRIT_ALG")
        lnRowCountAlg = .Rows.count
        lnColumnCountAlg = .Columns.count
        lnRowAlg = .row
        lnColumnAlg = .column
    End With
    
    With NewWorkBook.Sheets("OTBOR_COND").Range("KRIT_STR_COND")
        lnRowCountCond = .Rows.count
        lnColumnCountCond = .Columns.count
        lnRowCond = .row
        lnColumnCond = .column
    End With
    Application.ScreenUpdating = False
    While OldWorkBook.Sheets("ALG").Cells(rowAlg, 1).Text <> ""
        If OldWorkBook.Sheets("ALG").Cells(rowAlg, 3).Text = "" Then
            ' данные с ALG
            OldWorkBook.Activate
            lRazdel = OldWorkBook.Sheets("ALG").Cells(rowAlg, 6)
            lGraf = OldWorkBook.Sheets("ALG").Cells(rowAlg, 2)
            lLinkStr = OldWorkBook.Sheets("ALG").Cells(rowAlg, 1)
            If razdelCount > 1 Then
                OldWorkBook.Sheets(RazdelList(lRazdel)).Select
            End If
            lCode = getCode(getLineNum(lLinkStr))
            ' данные с OTBOR_COND
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 1, lnColumn - 1 + 1) = lLinkStr
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 1, lnColumn - 1 + 2) = lGraf
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 1, lnColumn - 1 + 3) = ""
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 1, lnColumn - 1 + 4) = lRazdel

            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 6, lnColumn - 1 + 1).CALCULATE
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 8, lnColumn - 1 + 1).CALCULATE
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 9, lnColumn - 1 + 1).CALCULATE
            OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 9, lnColumn - 1 + 2).CALCULATE
            lZnak = OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 6, lnColumn - 1 + 1)
            cond1 = OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 8, lnColumn - 1 + 1)
            If OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 9, lnColumn - 1 + 2) = 0 Then
                cond2 = OldWorkBook.Sheets("OTBOR_COND").Cells(lnRow + 9, lnColumn - 1 + 1)
            Else
                cond2 = ""
            End If
            ' новая книга
            NewWorkBook.Activate
            NewWorkBook.Sheets(RazdelList(lRazdel)).Select
            ' ищем строку с заданным кодом
            newStrLink = 0
            ' сначала проверим строку с тем же link-ом (99% что совпадет)
            lFlag = True
            If getLineNum(lLinkStr) = 0 Then lFlag = False
            If lFlag Then
                If lCode <> getCode(getLineNum(lLinkStr)) Then lFlag = False
            End If
            If lFlag Then
                newStrNum = getLineNum(lLinkStr)
                newStrLink = lLinkStr
            Else
                ' для оставшегося 1% делаем поиск по листу
                For i = NewWorkBook.Sheets("Service").Range("C5") To NewWorkBook.Sheets("Service").Range("A9")
                    If lCode = getCode(i) Then
                        newStrNum = i               'EdiS
                        newStrLink = NewWorkBook.Sheets("OTBOR_COND").Cells(i, 1)
                        Exit For
                    End If
                Next
            End If
            ' что-то нашли, будем проверять
            If newStrLink <> 0 Then
                ' посмотрим алгоритм на эту ячейку
                With NewWorkBook.Sheets("Alg")
                    .Range(.Cells(lnRowAlg + 1, lnColumnAlg), .Cells(lnRowAlg + 1, lnColumnAlg + lnColumnCountAlg - 1)) = ""
                    .Cells(lnRowAlg + 1, lnColumnAlg) = newStrLink
                    .Cells(lnRowAlg + 1, lnColumnAlg + 1) = lGraf
                    .Cells(lnRowAlg + 1, lnColumnAlg + 5) = lRazdel
                    .Cells(lnRowAlg, lnColumnAlg + 2).CALCULATE
                End With
                If IsError(NewWorkBook.Sheets("Alg").Cells(lnRowAlg + 2, lnColumnAlg)) Then
                ' алгоритма на ячейку не существует ВООБЩЕ
                ' посмотрим, нет ли других алгоритмов на ячейку(строки или графы)
                    ' строки
                    With NewWorkBook.Sheets("Alg")
                        .Range(.Cells(lnRowAlg + 1, lnColumnAlg), .Cells(lnRowAlg + 1, lnColumnAlg + lnColumnCountAlg - 1)) = ""
                        .Cells(lnRowAlg + 1, lnColumnAlg) = newStrLink
                        .Cells(lnRowAlg + 1, lnColumnAlg + 1) = 0
                        .Cells(lnRowAlg + 1, lnColumnAlg + 5) = lRazdel
                        
                        .Cells(lnRowAlg, lnColumnAlg + 2).CALCULATE
                        .Cells(lnRowAlg, lnColumnAlg + 3).CALCULATE
                    End With
                    If Not IsError(NewWorkBook.Sheets("Alg").Cells(lnRowAlg + 3, lnColumnAlg)) Then
                        Print #1, lCode + ", раздел '" + RazdelList(lRazdel) + "', графа " + VBA.Trim(VBA.str(lGraf)) + " установлен расчет по формуле (строки). Для обновления надо удалить расчет по формуле"
                    Else
                        With NewWorkBook.Sheets("Alg")
                            .Range(.Cells(lnRowAlg + 1, lnColumnAlg), .Cells(lnRowAlg + 1, lnColumnAlg + lnColumnCountAlg - 1)) = ""
                            .Cells(lnRowAlg + 1, lnColumnAlg) = -1
                            .Cells(lnRowAlg + 1, lnColumnAlg + 1) = lGraf
                            .Cells(lnRowAlg + 1, lnColumnAlg + 5) = lRazdel
                            
                            .Cells(lnRowAlg, lnColumnAlg + 2).CALCULATE
                        End With
                        If Not IsError(NewWorkBook.Sheets("Alg").Cells(lnRowAlg + 2, lnColumnAlg)) Then
                            Print #1, lCode + ", раздел '" + RazdelList(lRazdel) + "', графа " + VBA.Trim(VBA.str(lGraf)) + " установлен расчет по формуле (графы). Для обновления надо удалить расчет по формуле"
                        Else
                            ' Добавим алгоритм расчета ячейки
                            Call WORK_TABLE_ALG(newStrLink, lGraf, 0, "", 1, 1)
                            Call WORK_TABLE_STR_COND(newStrLink, lGraf, 0, 1, "", "", 1, cond1, cond2)
                            Print #1, "Добавлено условие по строке " + lCode + ", раздел '" + RazdelList(lRazdel) + "', графа " + VBA.Trim(VBA.str(lGraf)) + ":" + vbNewLine + "    " + cond1 + vbNewLine + "    " + cond2 + vbNewLine + "    номер алгоритма " + VBA.Trim(VBA.STR(lZnak))

                        End If
                    End If
                Else
                    If NewWorkBook.Sheets("Alg").Cells(lnRowAlg + 2, lnColumnAlg) = 1 Then
                        'в новом шаблоне тоже алгоритм по условию! Повезло...
                        'проверим теперь OTBOR_COND и готово...
                        With NewWorkBook.Sheets("OTBOR_COND")
                            .Range(.Cells(lnRowCond + 1, lnColumnCond), .Cells(lnRowCond + 1, lnColumnCond + lnColumnCountCond - 1)) = ""
                            .Cells(lnRowCond + 1, lnColumnCond) = newStrLink
                            .Cells(lnRowCond + 1, lnColumnCond + 1) = lGraf
                            .Cells(lnRowCond + 1, lnColumnCond + 3) = lRazdel
                            ' данные с OTBOR_COND
                            .Cells(lnRowCond + 6, lnColumnCond - 1 + 1).CALCULATE
                            .Cells(lnRowCond + 8, lnColumnCond - 1 + 1).CALCULATE
                            .Cells(lnRowCond + 9, lnColumnCond - 1 + 1).CALCULATE
                            .Cells(lnRowCond + 9, lnColumnCond - 1 + 2).CALCULATE
                            lZnakNew = .Cells(lnRowCond + 6, lnColumnCond - 1 + 1)
                            cond1New = .Cells(lnRowCond + 8, lnColumnCond - 1 + 1)
                            If .Cells(lnRowCond + 9, lnColumnCond - 1 + 2) = 0 Then
                                cond2New = .Cells(lnRowCond + 9, lnColumnCond - 1 + 1)
                            Else
                                cond2New = ""
                            End If
                        
                            .Range(.Cells(lnRowCond + 1, lnColumnCond), .Cells(lnRowCond + 1, lnColumnCond + lnColumnCountCond - 1)) = ""
                        End With
                        ' последнее сравнение
                        If cond1New <> cond1 Or cond2New <> cond2 Or lZnakNew <> lZnak Then
                            Call WORK_TABLE_STR_COND(newStrLink, lGraf, 0, 2, "", "", lZnak, cond1, cond2)
                            Print #1, "Строка " + lCode + ", раздел '" + RazdelList(lRazdel) + "', графа " + VBA.Trim(VBA.str(lGraf)) + " изменено на:" + vbNewLine + "    " + cond1 + vbNewLine + "    " + cond2 + vbNewLine + "    номер алгоритма " + VBA.Trim(VBA.str(lZnak))
                            Print #1, "    Старое условие: " + vbNewLine + "    " + cond1New + vbNewLine + "    " + cond2New + vbNewLine + "    номер алгоритма " + VBA.Trim(VBA.str(lZnakNew))
                        End If
                    Else
                        Print #1, lCode + ", раздел '" + RazdelList(lRazdel) + "', графа " + VBA.Trim(VBA.str(lGraf)) + " установлен расчет по формуле. Для обновления надо удалить расчет по формуле"
                    End If
                
                End If
                With NewWorkBook.Sheets("Alg")
                    .Range(.Cells(lnRowAlg + 1, lnColumnAlg), .Cells(lnRowAlg + 1, lnColumnAlg + lnColumnCountAlg - 1)) = ""
                End With
            Else
                Print #1, "Код " + lCode + "(раздел '" + RazdelList(lRazdel) + "')" + " отсутствует в новом шаблоне"
            End If
            
        End If
        rowAlg = rowAlg + 1
    Wend
    
    NewWorkBook.Activate
    Close #1
Application.ScreenUpdating = True
    
    Call Shell("notepad.exe c:\update_alg.txt", vbNormalFocus)
    

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 row As Integer
Dim i, count, iRazdel, Graf, bar, k, m, lnOccur, nCnt, typeF, lnNumRow1, j, realRow, razdelCount As Integer
Dim sheetsAlg, SheetsFORM As Object
Dim cSql, str1, str2, value, cCode, s, lcPart, lcLetter, lcZnak, str, lcFormText, tGraf, tBar As String
Dim newBar, newGraf, resTabName, cObject, cLink, cObjLink, lRazdelName  As String
Dim lcFormTextWork As String
Dim LookRange As Range
Dim lnColumn1, lnRow1, lnColumn, lnRow, lnRowCount, lnStartAddress, lnStartEmpty, lnNumRow As Long
Dim oRecordSet As Object
Dim sumFlag As Boolean
Dim PageList() 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
    
    On Error GoTo nnn
    If oAdoConnect Is Nothing Then
nnn:    'ADO Соединение
        Call AdoSrvConnect
    End If
    On Error GoTo doError
    
    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)
    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
    cSql = "EXECUTE A_EXEC 'SELECT LINK=dbo.obj_id(''" + VBA.Trim(Sheets("Service").Range("A15").Text) + "'')'"
    Set oRecordSet = CreateObject("ADODB.RecordSet")
    oRecordSet.Open cSql, oAdoConnect, 2, 1, 1
    cObject = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
    oRecordSet.Close
    Set oRecordSet = Nothing

    cSql = "EXECUTE A_EXEC 'SELECT LINK = dbo.obj_id(''CONTROL_FORMULA'')'"
    Set oRecordSet = CreateObject("ADODB.RecordSet")
    oRecordSet.Open cSql, oAdoConnect, 2, 1, 1
    cObjLink = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
    oRecordSet.Close
    Set oRecordSet = Nothing

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

    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
                cSql = "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 cSql, 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
                cSql = ""
                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
                        cSql = cSql + " 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 cSql <> "" Then oAdoConnect.Execute (cSql)
                    cSql = ""
            End If
            ' === сохранение формул ===
            For m = 1 To controlData(row).controlFormArr(i, j).count
                lcFormTextWork = controlData(row).controlFormArr(i, j).Item(m)
                If lcFormTextWork <> "" Then
                    cSql = "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 '" + cSql + "'", oAdoConnect, 2, 1, 1
                    cLink = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
                    oRecordSet.Close
                    Set oRecordSet = Nothing
                    cSql = "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 (cSql)
                    
                    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
                    cSql = ""
                    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
                            cSql = cSql + " 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 cSql <> "" Then oAdoConnect.Execute (cSql)
                        cSql = ""
                End If
            Next
        Next
    Next
    row = row + 1
Wend
Application.StatusBar = False
Exit Sub
doError:
    Call ERROR_EVENT("UpdateFormTable")
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, grafCol, lnRow1, lnColumn1, razdelCount, llRazdel As Integer
Dim sheetsOTBOR As Object
Dim cSql, str1, str2, value, cCode As String
Dim LookRange As Range

    On Error GoTo doError
    Set sheetsOTBOR = Sheets("OTBOR_COND")
    Sheets("Service").Range("A36") = 0
    Sheets("Service").Range("B43") = "##COND_TABLE" + VBA.Trim(VBA.str(Int(Rnd * 1000)))
    Call init_data
    On Error GoTo nnn
    If oAdoConnect Is Nothing Then
nnn:
        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
        grafCol = Sheets("Service").Range("S_GRAF").column
        value = VBA.Trim(Sheets("Service").Cells(row, grafCol + 4))
        While value <> ""
            count = 0
            While VBA.Trim(Sheets("Service").Cells(row, grafCol + 4)) = value
                count = count + 1
                row = row + 1
            Wend
            Sheets("Service").Range("B44") = VBA.Trim(Sheets("Service").Range("B44")) + "|" + VBA.Trim(VBA.str(count - 1))
            value = VBA.Trim(Sheets("Service").Cells(row, grafCol + 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
            str1 = convertForm(sheetsOTBOR.Cells(row, 8))
            str2 = 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))) + "', '" + str1 + "', '" + str2 + "','" + 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))) + "', '" + str1 + "', '" + str2 + "','" + 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))) + "', '" + str1 + "', '" + str2 + "','" + 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))) + "', '" + str1 + "', '" + str2 + "','" + 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)
    oAdoConnect.Execute ("EXECUTE V_UPDATE_COND_TABLE '" + VBA.Trim(Sheets("Service").Range("A15")) + "','" + VBA.Trim(Sheets("Service").Range("B43")) + "'")
    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
' -------------------------------------------------------------------------------------------------------
