Attribute VB_Name = "CONTROL_R"
Option Explicit

Public Type controlType
            controlFormArr() As New Collection
            controlZnakArr() As New Collection
            controlFormNum() As New Collection
            controlLoadFlag As Boolean
'            controlLinkArr() As Long (ряд(№ строки),колонка(1-3), № формулы)
        End Type
Public controlData() As controlType

Public Type algType
            alg1Arr() As String  'условие общей выборки или формула расчета
            alg2Arr() As String
            FormArr() As String
            algZnakArr() As Byte
            algType() As Byte    '6,5 - из алгоритма(форм.) ячейки, 4,3 - из алгоритма строки, 2,1 - из алгоритма графы
            formType() As Byte
            algLoadFlag As Boolean
'            controlLinkArr() As Long
        End Type
Type arrType
    data() As String
    Razdel() As String
    flag As Boolean
End Type

Public algData() As algType, letArr() As arrType, modeNoCalc() As Byte, noCalcFlag As Boolean, errList As String
' -------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub readAlgData(page As Integer)
Dim i, sheetsAlg As Object, j, sheetsService As Object, columnCount As Integer, _
    rowCount As Integer, sheetsOtbor_cond As Object, SheetsFORM As Object, _
    LookRange As Range, realRow, lSheetsAlg As Object, sheetsReport As Object, temp As String, _
    areas, grafList As String
    
On Error GoTo doError
    
    temp = Application.StatusBar
    Application.StatusBar = "Подождите ...   Идет загрузка условий отбора ..."
    Set sheetsAlg = Sheets("ALG")
    Set SheetsFORM = Sheets("FORM")
    Set sheetsService = Sheets("Service")
    Set sheetsOtbor_cond = Sheets("OTBOR_COND")
    Set sheetsReport = Sheets(VBA.Trim(sheetsService.Range("B19")))
    columnCount = sheetsService.Range("A10")
    rowCount = sheetsService.Range("A9") - sheetsService.Range("C5") + 1
    
    grafList = "," + VBA.Trim(VBA.Trim(sheetsService.Range("B46").Text)) + ","
    If grafList = ",," Then grafList = ",1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,"
    
    ReDim algData(page).alg1Arr(rowCount, columnCount)
    ReDim algData(page).alg2Arr(rowCount, columnCount)
    ReDim algData(page).algZnakArr(rowCount, columnCount)
    ReDim algData(page).algType(rowCount, columnCount)
    ReDim algData(page).FormArr(rowCount, columnCount)
    ReDim algData(page).formType(rowCount, columnCount)

    ' проверим наличие ячеек со спец. св-вами
    If exists_name("TABLE_CELLS_PROP") Then
        noCalcFlag = True
        ReDim modeNoCalc(rowCount, columnCount)
        With sheetsService
            i = .Range("TABLE_CELLS_PROP").row + 1
            While .Cells(i, .Range("TABLE_CELLS_PROP").column).Text <> ""
                If .Cells(i, .Range("TABLE_CELLS_PROP").column + 2) = page Then
                    Set LookRange = sheetsReport.Range("LINK").Find(.Cells(i, .Range("TABLE_CELLS_PROP").column), LookIn:=xlFormulas, lookat:=xlWhole)
                    If Not LookRange Is Nothing Then
                        realRow = LookRange.row - sheetsService.Range("C5")
                        sheetsService.Visible = True
                        modeNoCalc(realRow, .Cells(i, .Range("TABLE_CELLS_PROP").column + 1)) = .Cells(i, .Range("TABLE_CELLS_PROP").column + 3)
                    End If
                End If
                i = i + 1
            Wend
        End With
    Else
        noCalcFlag = False
    End If
    
    i = 2
    While sheetsAlg.Cells(i, 1).Text <> ""
        If sheetsAlg.Cells(i, 6) = page Then
        
            If sheetsAlg.Cells(i, 4) = 1 Then ' по алгоритму
                
           
            Else ' по формуле
                SheetsFORM.Range(SheetsFORM.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN), SheetsFORM.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + KRIT_FORM_COLUMNCOUNT - 2)) = ""
                SheetsFORM.Cells(KRIT_FORM_ROW + 1, KRIT_FORM_COLUMN + 2) = sheetsAlg.Cells(i, 3)
                SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN).CALCULATE
                SheetsFORM.Cells(KRIT_FORM_ROW + 7, KRIT_FORM_COLUMN).CALCULATE
                
                If sheetsAlg.Cells(i, 2) = 0 Then 'вся строка
                    Set LookRange = sheetsReport.Range("LINK").Find(sheetsAlg.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlWhole)
                    realRow = LookRange.row - sheetsService.Range("C5")
                    
                        For j = 1 To columnCount
                            If algData(page).formType(realRow, j) < 2 And (VBA.InStr(grafList, "," + VBA.Trim(VBA.str(j)) + ",") <> 0 Or page <> 1) Then
                                
                                If noCalcFlag Then
                                    If (modeNoCalc(realRow, j) And 1) = 0 Then
                                        algData(page).FormArr(realRow, j) = Replace_in_Str(SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN), "@", letArr(page).data(j))
                                        algData(page).formType(realRow, j) = 2
                                    End If
                                Else
                                    algData(page).FormArr(realRow, j) = Replace_in_Str(SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN), "@", letArr(page).data(j))
                                    algData(page).formType(realRow, j) = 2
                                End If
                                
                            End If
                        Next
                End If
                If sheetsAlg.Cells(i, 1) = -1 Then 'вся графа
                    For j = sheetsService.Range("C5") To sheetsService.Range("A9")
                        If Val(sheetsReport.Cells(j, 1).Text) > 0 Then
                    
                            realRow = j - sheetsService.Range("C5")
                            If (algData(page).formType(realRow, sheetsAlg.Cells(i, 2)) < 1) And (VBA.InStr(grafList, "," + VBA.Trim(VBA.str(sheetsAlg.Cells(i, 2))) + ",") <> 0 Or page <> 1) Then
                            
                                If noCalcFlag Then
                                    If (modeNoCalc(realRow, sheetsAlg.Cells(i, 2)) And 2) = 0 Then
                                        algData(page).FormArr(realRow, sheetsAlg.Cells(i, 2)) = Replace_in_Str(SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN), "$", "")
                                        algData(page).formType(realRow, sheetsAlg.Cells(i, 2)) = 1
                                    End If
                                Else
                                    algData(page).FormArr(realRow, sheetsAlg.Cells(i, 2)) = Replace_in_Str(SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN), "$", "")
                                    algData(page).formType(realRow, sheetsAlg.Cells(i, 2)) = 1
                                End If
                            
                            End If
                        End If
                    Next
                End If
                
                If (sheetsAlg.Cells(i, 2) <> 0) And (sheetsAlg.Cells(i, 1) <> -1) Then
                    'ячейка
                        Set LookRange = sheetsReport.Range("LINK").Find(sheetsAlg.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlWhole)
                        realRow = LookRange.row - sheetsService.Range("C5")
                        If (algData(page).formType(realRow, sheetsAlg.Cells(i, 2)) < 3) And (sheetsAlg.Cells(i, 1) <> -1) And (VBA.InStr(grafList, "," + VBA.Trim(VBA.str(sheetsAlg.Cells(i, 2))) + ",") <> 0 Or page <> 1) Then
                       
                            If noCalcFlag Then
                                If (modeNoCalc(realRow, sheetsAlg.Cells(i, 2)) And 4) = 0 Then
                                    algData(page).FormArr(realRow, sheetsAlg.Cells(i, 2)) = SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN)
                                    algData(page).formType(realRow, sheetsAlg.Cells(i, 2)) = 3
                                End If
                            Else
                                algData(page).FormArr(realRow, sheetsAlg.Cells(i, 2)) = SheetsFORM.Cells(KRIT_FORM_ROW + 2, KRIT_FORM_COLUMN)
                                algData(page).formType(realRow, sheetsAlg.Cells(i, 2)) = 3
                            End If
                        
                        End If
                End If
            
            End If
        End If
        i = i + 1
    Wend
    algData(page).algLoadFlag = True
    Application.StatusBar = temp
Exit Sub
doError:
    Call ERROR_EVENT("readAlgData")
End Sub
' -------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub readControlData(page As Integer)
Dim i, SheetsFORM As Object, j, sheetsService As Object, columnCount As Integer, _
    rowCount As Integer, LookRange As Range, sheetsReport As Object, realRow, temp As String
Dim key As Integer
    
    On Error GoTo doError
    Set SheetsFORM = Sheets("FORM")
    Set sheetsService = Sheets("Service")
    Set sheetsReport = Sheets(VBA.Trim(sheetsService.Range("B19")))
    
    temp = Application.StatusBar
    Application.StatusBar = "Подождите ...   Идет загрузка формул ..."
    
    columnCount = sheetsService.Range("A10")
    rowCount = sheetsService.Range("A9") - sheetsService.Range("C5") + 1
    
    ReDim controlData(page).controlFormArr(rowCount, columnCount)
    ReDim controlData(page).controlZnakArr(rowCount, columnCount)
    ReDim controlData(page).controlFormNum(rowCount, columnCount)
    
    ' проверим наличие ячеек со спец. св-вами
    If exists_name("TABLE_CELLS_PROP") Then
        noCalcFlag = True
        ReDim modeNoCalc(rowCount, columnCount)
        With sheetsService
            i = .Range("TABLE_CELLS_PROP").row + 1
            While .Cells(i, .Range("TABLE_CELLS_PROP").column).Text <> ""
                If .Cells(i, .Range("TABLE_CELLS_PROP").column + 2) = page Then
                    Set LookRange = sheetsReport.Range("LINK").Find(.Cells(i, .Range("TABLE_CELLS_PROP").column), LookIn:=xlFormulas, lookat:=xlWhole)
                    realRow = LookRange.row - sheetsService.Range("C5")
                    modeNoCalc(realRow, .Cells(i, .Range("TABLE_CELLS_PROP").column + 1)) = .Cells(i, .Range("TABLE_CELLS_PROP").column + 3)
                End If
                i = i + 1
            Wend
        End With
    Else
        noCalcFlag = False
    End If
    
    
    i = 2
    While SheetsFORM.Cells(i, 1).Text <> ""
        If SheetsFORM.Cells(i, 8) = page Then
            Select Case SheetsFORM.Cells(i, 7)
                Case 1 'вся строка
                    Set LookRange = sheetsReport.Range("LINK").Find(SheetsFORM.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlWhole)
                    realRow = LookRange.row - sheetsService.Range("C5")
                    For j = 1 To columnCount
                        key = controlData(page).controlFormArr(realRow, j).count + 1
                        If noCalcFlag Then
                            If (modeNoCalc(realRow, j) And 1) = 0 Then
                                controlData(page).controlFormArr(realRow, j).Add Replace_in_Str(SheetsFORM.Cells(i, 4), "@", letArr(page).data(j)), VBA.str(key)
                                controlData(page).controlZnakArr(realRow, j).Add SheetsFORM.Cells(i, 5), VBA.str(key)
                                controlData(page).controlFormNum(realRow, j).Add SheetsFORM.Cells(i, 3), VBA.str(key)
                            End If
                        Else
                            controlData(page).controlFormArr(realRow, j).Add Replace_in_Str(SheetsFORM.Cells(i, 4), "@", letArr(page).data(j)), VBA.str(key)
                            controlData(page).controlZnakArr(realRow, j).Add SheetsFORM.Cells(i, 5), VBA.str(key)
                            controlData(page).controlFormNum(realRow, j).Add SheetsFORM.Cells(i, 3), VBA.str(key)
                        End If
                        
                    Next
                Case 4 'вся графа
                    For j = sheetsService.Range("C5") To sheetsService.Range("A9")
                        If Val(sheetsReport.Cells(j, 1).Text) > 0 Then
                            realRow = j - sheetsService.Range("C5")
                            key = controlData(page).controlFormArr(realRow, SheetsFORM.Cells(i, 2)).count + 1
                            
                            If noCalcFlag Then
                                If (modeNoCalc(realRow, SheetsFORM.Cells(i, 2)) And 2) = 0 Then
                                    controlData(page).controlFormArr(realRow, SheetsFORM.Cells(i, 2)).Add Replace_in_Str(SheetsFORM.Cells(i, 4), "$", ""), VBA.str(key)
                                    controlData(page).controlZnakArr(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 5), VBA.str(key)
                                    controlData(page).controlFormNum(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 3), VBA.str(key)
                                End If
                            Else
                                controlData(page).controlFormArr(realRow, SheetsFORM.Cells(i, 2)).Add Replace_in_Str(SheetsFORM.Cells(i, 4), "$", ""), VBA.str(key)
                                controlData(page).controlZnakArr(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 5), VBA.str(key)
                                controlData(page).controlFormNum(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 3), VBA.str(key)
                            End If
                        End If
                    Next
                Case 2 'одна ячейка
                        Set LookRange = sheetsReport.Range("LINK").Find(SheetsFORM.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlWhole)
                        realRow = LookRange.row - sheetsService.Range("C5")
                        key = controlData(page).controlFormArr(realRow, SheetsFORM.Cells(i, 2)).count + 1
                        
                        If noCalcFlag Then
                            If (modeNoCalc(realRow, SheetsFORM.Cells(i, 2)) And 4) = 0 Then
                                controlData(page).controlFormArr(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 4), VBA.str(key)
                                controlData(page).controlZnakArr(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 5), VBA.str(key)
                                controlData(page).controlFormNum(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 3), VBA.str(key)
                            End If
                        Else
                            controlData(page).controlFormArr(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 4), VBA.str(key)
                            controlData(page).controlZnakArr(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 5), VBA.str(key)
                            controlData(page).controlFormNum(realRow, SheetsFORM.Cells(i, 2)).Add SheetsFORM.Cells(i, 3), VBA.str(key)
                        End If
            End Select
        End If
        i = i + 1
    Wend
    
   
    controlData(page).controlLoadFlag = True
    Application.StatusBar = temp
Exit Sub
doError:
    Call ERROR_EVENT("readControlData")
End Sub
' -------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub readLetterData(Optional page As Integer = 0)
Dim pageRazd, columnCount, rowCount, i
With Sheets("Service")
    If page = 0 Then page = .Range("B20")
    columnCount = .Range("A10")
    rowCount = .Range("A9") - .Range("C5") + 1
    
    'читаем раздел листа
    .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = page
    .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + 1) = ""
    .Cells(KRIT_RAZDEL_ROW + 5, KRIT_RAZDEL_COLUMN).CALCULATE
    pageRazd = .Cells(KRIT_RAZDEL_ROW + 5, KRIT_RAZDEL_COLUMN)
    .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = ""
    
    ReDim letArr(page).data(columnCount)
    ReDim letArr(page).Razdel(columnCount)
    .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 2) = page
    .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 1) = ""
    For i = 1 To columnCount
        .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = i
        .Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN).CALCULATE
        .Cells(KRIT_GRAF_ROW + 5, KRIT_GRAF_COLUMN).CALCULATE
        letArr(page).data(i) = .Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN)
        letArr(page).Razdel(i) = VBA.Trim(pageRazd) + VBA.Trim(.Cells(KRIT_GRAF_ROW + 5, KRIT_GRAF_COLUMN))
    Next
    .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = ""
    
    letArr(page).flag = True
End With
End Sub
' -------------------------------------------------------------------------------------------------------
' Модуль контроля по формулам
' Процедура контроля одной ячейки по формулам
' lnCellLink - Link строки
' lnRowCell - порядковый номер строки Excel
' lnColumnCell - порядковый номер колонки Excel
' Возвращает True - если была ошибка, иначе False
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Function CONTROL_CELL(ByVal lnCellLink As Long, ByVal lnRowCell As Long, _
                        ByVal lnColumnCell As Long, Optional Razdel As Variant = "", Optional bk As Variant = "") As Boolean

Dim lnNewValue As Double, lbResult As Boolean, lcFormula As String, _
    lnColumn As Long, lnRow As Long, realRow As Integer
Dim lSheetsReport As Object, lSheetsService As Object, page As Integer, err_ As Boolean, j As Integer
Dim lnCurrentValue As Double, a(3), v, i, lcFormText, lnCodeItog, lcNameItog, columnCount, rowCount, pageRazd As String
Dim nCnt1 As Integer, nCnt2 As Integer, nCnt3 As Integer
Dim tempStr As String, lStr As String, errStr As String
Dim lArea
Dim lCells
Dim lSheets
    
On Error GoTo doError

Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
Set lSheetsService = Sheets("Service")

If lSheetsReport.Cells(lnRowCell, lnColumnCell).Locked Then
    lbResult = True
    Exit Function
End If
page = lSheetsService.Range("B20")

If letArr(page).flag = False Then
    readLetterData (page)
End If

If controlData(page).controlLoadFlag = False Then
    Call readControlData(page)
End If

' Запомним старое значение
lnCurrentValue = IIf(IsEmpty(lSheetsReport.Cells(lnRowCell, lnColumnCell).Value), 0#, lSheetsReport.Cells(lnRowCell, lnColumnCell).Value)
' Посмотрим, а есть ли формула
lcFormula = lSheetsReport.Cells(lnRowCell, lnColumnCell).FormulaLocal
' Выцепим текст формулы
realRow = lnRowCell - Sheets("Service").Range("C5")
lSheetsReport.Cells(lnRowCell, lnColumnCell).Interior.ColorIndex = xlColorIndexNone
If Not lSheetsReport.Cells(lnRowCell, lnColumnCell).Comment Is Nothing Then
    lSheetsReport.Cells(lnRowCell, lnColumnCell).Comment.Delete
End If
err_ = False

    For j = 1 To controlData(page).controlFormArr(realRow, lnColumnCell - pnAddress_Col + 1).count
        lcFormText = controlData(page).controlFormArr(realRow, lnColumnCell - pnAddress_Col + 1).Item(j)
        If Not lcFormText = "" Then
            lnCodeItog = controlData(page).controlZnakArr(realRow, lnColumnCell - pnAddress_Col + 1).Item(j)
            ' Пропишем формулу в ячейку
            Call FILL_CELL_FORM(lcFormText, lnRowCell, lnColumnCell)
            ' Считаем новое значение
            lnNewValue = lSheetsReport.Cells(lnRowCell, lnColumnCell).Value
            Select Case lnCodeItog
                Case 1
                    lbResult = VBA.Int(VBA.Abs(lnCurrentValue - lnNewValue) * 1000) / 1000 = 0
                Case 2
                    lbResult = VBA.Int(lnCurrentValue * 1000) / 1000 >= VBA.Int(lnNewValue * 1000) / 1000
                Case 3
                    lbResult = (VBA.Int(lnCurrentValue * 1000) / 1000 <= VBA.Int(lnNewValue * 1000) / 1000)
                Case 4
                    lbResult = (VBA.Int(lnCurrentValue * 1000) / 1000 > VBA.Int(lnNewValue * 1000) / 1000)
                Case 5
                    lbResult = (VBA.Int(lnCurrentValue * 1000) / 1000 < VBA.Int(lnNewValue * 1000) / 1000)
            End Select
            
            tempStr = ""
            lStr = VBA.Mid(lSheetsReport.Cells(lnRowCell, lnColumnCell).FormulaLocal, 2)
            
            If lcFormula = "" Then
                'Восстанавливаем старое значение
                lSheetsReport.Cells(lnRowCell, lnColumnCell).Value = lnCurrentValue
            Else
                'Восстанавливаем формулу
                lSheetsReport.Cells(lnRowCell, lnColumnCell).FormulaLocal = lcFormula
            End If
            If Not lbResult Then ' неправильно
                err_ = True
                ' Заполнение критерия
                With lSheetsService
                    .Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN) = lnCodeItog
                    lcNameItog = .Cells(KRIT_ZNAK_ROW + 2, KRIT_ZNAK_COLUMN)
                    ' Сброс критерия
                    .Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN) = ""
                End With
                errStr = ""
                If ThisWorkbook.Sheets("Service").Range("A30") = 0 Then
                    Call FILL_CONTROL_LIST(lnCurrentValue, lnNewValue, _
                                         lnRowCell, lnColumnCell, _
                                         lnCellLink, lcNameItog, 0, controlData(page).controlFormNum(realRow, lnColumnCell - pnAddress_Col + 1).Item(j), tempStr)
                Else
                    'Stop
                    If Razdel <> "" Then
                        errStr = errStr + vbCrLf
                        errStr = errStr + " Раздел " + Razdel + vbCrLf
                        Razdel = ""
                    End If
                    If bk <> "" Then
                        errStr = errStr + vbCrLf
                        errStr = errStr + " БК:  " + bk + vbCrLf
                        bk = ""
                    End If

                    errStr = errStr + vbCrLf
                    errStr = errStr + getFormula(controlData(page).controlFormNum(realRow, lnColumnCell - pnAddress_Col + 1).Item(j), lnRowCell, lnColumnCell - pnAddress_Col + 1) + vbCrLf
                    errStr = errStr + "    введено     " + VBA.Format(lnCurrentValue, "###0.00") + vbCrLf
                    errStr = errStr + "    расчитано   " + VBA.Format(lnNewValue, "###0.00") + " (" + tempStr + ")" + vbCrLf
                    errStr = errStr + "    расхождение " + VBA.Format(lnCurrentValue - lnNewValue, "###0.00") + vbCrLf
                End If
                    errList = errList + errStr

                'Красим в красный цвет
                lSheetsReport.Cells(lnRowCell, lnColumnCell).Interior.ColorIndex = 3
            Else
                'Восстановим цвет
                'lSheetsReport.Cells(lnRowCell, lnColumnCell).Interior.ColorIndex = xlColorIndexNone
            End If

            
        Else
            lbResult = True
        End If
    Next

CONTROL_CELL = err_
Exit Function
doError:
    Call ERROR_EVENT("CONTROL_CELL")
End Function
' -------------------------------------------------------------------------------------------------------
' Процедура чистит контроли
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub CLEAR_CONTROL()
Dim LookRange As Range, row, col
Dim lCells
    Set LookRange = Sheets("Контроль").Range("A1:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
    row = Sheets("Контроль").Range("CLEAR_CONTROL").row
    col = Sheets("Контроль").Range("CLEAR_CONTROL").column
    
    Sheets("Контроль").Range(Sheets("Контроль").Cells(1, 1), Sheets("Контроль").Cells(LookRange.row, col + Sheets("Контроль").Range("CLEAR_CONTROL").Columns.count)) = ""
    With Sheets("Контроль").Range(Sheets("Контроль").Cells(1, 1), Sheets("Контроль").Cells(LookRange.row, col + Sheets("Контроль").Range("CLEAR_CONTROL").Columns.count))
        .Interior.ColorIndex = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlTop
        For Each lCells In .Cells
            If Not lCells.Comment Is Nothing Then lCells.Comment.Delete
        Next
    End With
    With Sheets("Контроль").Range(Sheets("Контроль").Cells(row, col), Sheets("Контроль").Cells(LookRange.row, col + 1))
        .NumberFormat = "@"
        .HorizontalAlignment = xlLeft
        .RowHeight = 12
    End With
    Sheets("Контроль").Cells(row, 1) = VBA.Trim(Sheets("Service").Range("B2")) + " на " + VBA.Trim(Sheets("Service").Range("B1"))
    Sheets("Контроль").Cells(1, 1) = VBA.Trim(Sheets("Service").Range("C2"))
    Application.Names.Add name:="CODE_STR_CONTROL", RefersTo:="=Контроль!$B$1:$B$60000"
End Sub
' -------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub addHead()
Dim lSheetsControl As Object, LookRange As Range, i, lSheetsService

Set lSheetsControl = Sheets("Контроль")
Set lSheetsService = Sheets("Service")
Set LookRange = lSheetsControl.Range("A1:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
With lSheetsControl
    .Cells(LookRange.row, 1) = " "
    .Cells(LookRange.row + 1, 1) = "Раздел """ + lSheetsService.Range("B19") + """"
    .Cells(LookRange.row + 1, 1).Interior.ColorIndex = 4
    .Cells(LookRange.row + 2, 1) = "Наименование"
    .Cells(LookRange.row + 2, 2) = "Код"
    For i = 1 To lSheetsService.Range("A10")
        lSheetsService.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = i
        lSheetsService.Cells(KRIT_GRAF_ROW + 2, KRIT_GRAF_COLUMN).CALCULATE
        .Cells(LookRange.row + 2, 2 + i) = lSheetsService.Cells(KRIT_GRAF_ROW + 2, KRIT_GRAF_COLUMN)
    Next
    With .Range(.Cells(LookRange.row + 2, 1), .Cells(LookRange.row + 2, Sheets("Service").Range("A10") + 2))
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Application.Names.Add name:="CODE_STR_CONTROL", RefersTo:="=Контроль!$B$" + VBA.Trim(VBA.str(LookRange.row + 1)) + ":$B$60000"
    .Rows(LookRange.row + 2).AutoFit
End With
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура контроля документа по формулам контроля
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub CONTROL_REPORT()
Dim pnWhatCalculate As Integer, nCnt As Integer, nCntCol As Integer, lnCellLink As Integer
Dim lnRowCell As Integer, lnColumnCell As Integer, hWnd As Long, lbError As Boolean
Dim lSheetsReport As Object, lSheetsControl As Object, lSheetsService As Object
Dim lnCountAllRow, lnCountAllColumn, lbResult, lnColumn1, lnRow1, i, oldSheet

On Error GoTo doError

With ThisWorkbook.Sheets("Service")
    pnAddress_Row = .Range("C5")
    pnAddress_Col = .Range("C6")
End With

Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
' Определим активную ячейку
lnRowCell = ActiveCell.row
lnColumnCell = ActiveCell.column
lnCellLink = lSheetsReport.Cells(lnRowCell, 1)   ' считаем LINK колонки

If lnCellLink = 0 Then Exit Sub ' Если Link = 0 Не контролируем

Set lSheetsService = Sheets("Service")
lnCountAllRow = lSheetsService.Range("A9")
lnCountAllColumn = lSheetsService.Range("A10")
    
    If lnRowCell >= pnAddress_Row And _
        lnRowCell <= lnCountAllRow + pnAddress_Row - 1 And _
        lnColumnCell >= pnAddress_Col And _
        lnColumnCell <= pnAddress_Col + lnCountAllColumn - 1 Then
    
        ' Попадает в виртуальное поле ввода
        Set lSheetsControl = Sheets("Контроль")
        lSheetsService.Range(lSheetsService.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN), lSheetsService.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + KRIT_GRAF_COLUMNCOUNT - 2)) = ""
        
        'Флаг наличия расхождения
        lbError = False

        pnWhatCalculate = 1 '(1 - ячейка, 2 - строка, 3 - графа, 4 - весь документ)
        MODE_CONTROL.Show ' вызов формы контроля
        If pbFormCancel Then
            pnWhatCalculate = MODE_CONTROL.pnWhatCalculate
            Unload MODE_CONTROL
            ' Locked screen
            Application.StatusBar = "Подождите ... Идет контроль документа по формулам"
            hWnd = FindWindow("XLMAIN", 0)
            LockWindowUpdate (hWnd)
            
            'Обнуление бланка отчета
            If pnWhatCalculate <> 4 Then
                With lSheetsControl
                    Call CLEAR_CONTROL
                    Call addHead
        '            .Range("Clear_Control").Clear
        '            .Range("Clear_Control").Interior.ColorIndex = 0
                    'нарисуем шапку
                End With
            End If
            'pPermitUpd = False
            Sheets("Service").Range("A37").Value = 1
            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
                        If VarType(lSheetsReport.Cells(lnRowCell, lnColumnCell)) <> vbString Then
                            ' защита листа - снять
                            lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                            If lnCellLink = 0 Then Exit Sub
                            lbResult = CONTROL_CELL(lnCellLink, lnRowCell, _
                                        lnColumnCell)
                            If lbResult Then ' неправильно
                                lbError = True
                            End If
                            ' защита листа - поставить
                            lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                        End If
                    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
                        ' защита листа - снять
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                        If lnCellLink = 0 Then Exit Sub
                        For nCnt = 1 To lnCountAllColumn
                            lnColumnCell = nCnt - 1 + pnAddress_Col
                            If VarType(lSheetsReport.Cells(lnRowCell, lnColumnCell)) <> vbString Then
                                lbResult = CONTROL_CELL(lnCellLink, lnRowCell, _
                                            lnColumnCell)
                                If lbResult Then ' неправильно
                                    lbError = True
                                End If
                            End If
                        Next
                        ' защита листа - поставить
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                    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
                        ' защита листа - снять
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                        For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
                            lnCellLink = lSheetsReport.Cells(nCnt, 1)
                            If lnCellLink <> 0 Then
                                If VarType(lSheetsReport.Cells(lnRowCell, lnColumnCell)) <> vbString Then
                                    lbResult = CONTROL_CELL(lnCellLink, nCnt, _
                                                lnColumnCell)
                                    If lbResult Then ' неправильно
                                        lbError = True
                                    End If
                                End If
                            End If
                        Next
                        ' защита листа - поставить
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                    End If
                Case 4 ' Контроль всего документа
                    With lSheetsService.Range("KRIT_RAZDEL")
                         lnColumn1 = .column
                         lnRow1 = .row
                    End With
                    Call CLEAR_CONTROL
                    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
                            Set lSheetsReport = Application.ActiveWorkbook.Sheets(lSheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
                        End If
                        lSheetsReport.Activate
                        ' защита листа - снять
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

                        lnCountAllRow = lSheetsService.Range("A9")
                        lnCountAllColumn = lSheetsService.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
                            Call addHead
                            For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
                                lnCellLink = lSheetsReport.Cells(nCnt, 1)
                                If lnCellLink <> 0 Then
                                    For nCntCol = 1 To lnCountAllColumn
                                        lnColumnCell = nCntCol - 1 + pnAddress_Col
                                        If VarType(lSheetsReport.Cells(lnRowCell, lnColumnCell)) <> vbString Then
                                            lbResult = CONTROL_CELL(lnCellLink, nCnt, _
                                                    lnColumnCell)
                                                    'nCntCol)
                                            If lbResult Then ' неправильно
                                                lbError = True
                                            End If
                                        End If
                                    Next
                                End If
                            Next
                        End If
                        ' защита листа - поставить
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                    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
                        ' защита листа - снять
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                        For nCnt = pnAddress_Row To pnAddress_Row + lnCountAllRow + 1
                            lnCellLink = lSheetsReport.Cells(nCnt, 1)
                            If lnCellLink <> 0 Then
                                For nCntCol = 1 To lnCountAllColumn
                                    lnColumnCell = nCntCol - 1 + pnAddress_Col
                                    If VarType(lSheetsReport.Cells(lnRowCell, lnColumnCell)) <> vbString Then
                                        lbResult = CONTROL_CELL(lnCellLink, nCnt, _
                                                lnColumnCell)
                                                'nCntCol)
                                        If lbResult Then ' неправильно
                                            lbError = True
                                        End If
                                    End If
                                Next
                            End If
                        Next
                        ' защита листа - поставить
                        lSheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                    End If
            End Select
            ' Restore screen
            LockWindowUpdate (0)
            Application.StatusBar = False
            
            'Проверим флаг наличия расхождения
            If lbError Then
               lSheetsControl.Visible = True
               lSheetsControl.Activate
            Else
               lSheetsControl.Visible = False
               MsgBox "Контроль пройден успешно !", vbInformation + vbOKOnly, pcNameApp & "Внимание"
            End If
        End If
        
        'pPermitUpd = True
        Sheets("Service").Range("A37").Value = 0
    End If
    
Exit Sub
doError:
    Call ERROR_EVENT("CONTROL_REPORT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура заполнения Листа ошибок
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub FILL_CONTROL_LIST(ByVal lnOldValue As Double, ByVal lnNewValue As Double, _
                             ByVal lnNumRow As Integer, ByVal lnNumCol As Integer, _
                             ByVal lnCellLink As Integer, ByVal lcNameItog, typeError As Integer, _
                             Optional numControl As Variant = 0, Optional addData As String = "")
Dim lnLinkRow, lnCurrRow, i As Integer
Dim lcNameStr, lcCodeStr As String
Dim LookRange As Range
Dim lSheetsControl, lSheetsReport As Object

Set lSheetsControl = Sheets("Контроль")
Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)

Set LookRange = lSheetsControl.Range("A1:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
lnCurrRow = LookRange.row
Set LookRange = Nothing

' считаем LINK,Наименование и Код отч.
With lSheetsReport
    lnLinkRow = .Cells(lnNumRow, pnAddress_Col - Sheets("Service").Range("E2"))
    lcNameStr = IIf(Sheets("Service").Range("E5") <> 0, .Cells(lnNumRow, pnAddress_Col - Sheets("Service").Range("E5")), " ")
    lcCodeStr = getCode(lnNumRow)
End With

With lSheetsControl
    'Посмотрим есть ли эта запись в бланке контроля
    Set LookRange = Nothing
    Select Case typeError
        Case Is = 0 'ошибка при контроле
                .Range(.Cells(lnCurrRow, 1), .Cells(lnCurrRow, Sheets("Service").Range("A10") + 2)).Interior.ColorIndex = 8
                .Cells(lnCurrRow, 1) = lcNameStr
                .Cells(lnCurrRow, 2) = lcCodeStr
                .Cells(lnCurrRow + 1, 1).Value = "Введено :"
                .Cells(lnCurrRow + 2, 1).Value = "Раcсчитано :"
                i = 0
                While VBA.Trim(addData) <> "" And VBA.Trim(addData) <> "|"
                    i = i + 1
                    .Cells(lnCurrRow + 2 + i, lnNumCol - pnAddress_Col + 3).Value = getNextSubstr(addData, "|")
                    .Cells(lnCurrRow + 2 + i, 1).Value = " "
                    .Cells(lnCurrRow + 2 + i, lnNumCol - pnAddress_Col + 3).Interior.ColorIndex = 40
                Wend
                
                .Cells(lnCurrRow + 3 + i, 1).Value = "Знак итога :"
                .Cells(lnCurrRow + 4 + i, 1).Value = "Расхождение :"
            ' Заполнение данными
            .Cells(lnCurrRow + 1, lnNumCol - pnAddress_Col + 3).Value = Format(lnOldValue, "###0.00")
            .Cells(lnCurrRow + 2, lnNumCol - pnAddress_Col + 3).Value = Format(lnNewValue, "###0.00")
            .Cells(lnCurrRow + 3 + i, lnNumCol - pnAddress_Col + 3).Value = lcNameItog
            .Cells(lnCurrRow + 4 + i, lnNumCol - pnAddress_Col + 3).Value = Format(lnOldValue - lnNewValue, "###0.00")
            'добавим комментарий
            If Not lSheetsReport.Cells(lnNumRow, lnNumCol).Comment Is Nothing Then
                lSheetsReport.Cells(lnNumRow, lnNumCol).Comment.Delete
            End If
            lSheetsReport.Cells(lnNumRow, lnNumCol).AddComment ("Ошибка " + IIf(numControl = 0, "", "(формула №" + VBA.Trim(VBA.str(numControl)) + ")") + ":" + vbNewLine + "  расcчитано  : " + VBA.Format(lnNewValue, "##0.00") + Chr(10) + _
                                                                                      "  расхождение: " + VBA.Format(lnOldValue - lnNewValue, "##0.00") + vbNewLine)
            lSheetsReport.Cells(lnNumRow, lnNumCol).Comment.Shape.ScaleWidth 2.2, msoFalse, msoScaleFromTopLeft
        Case Is = 1 'ошибка при расчете
            .Range("A" + VBA.Trim(VBA.str(lnCurrRow)), "E" + VBA.Trim(VBA.str(lnCurrRow))).Interior.ColorIndex = 27
            .Cells(lnCurrRow, 1).Value = lcNameStr
            .Cells(lnCurrRow, 2).Value = lcCodeStr
            .Cells(lnCurrRow + 1, 1).Value = "Расхождение результатов расчета"
            .Cells(lnCurrRow + 2, 1).Value = "Расчет 1 :"
            .Cells(lnCurrRow + 3, 1).Value = "Расчет 2 :"
            .Cells(lnCurrRow + 4, 1).Value = "Знак итога :"
            .Cells(lnCurrRow + 5, 1).Value = "Расхождение :"
            .Cells(lnCurrRow + 2, lnNumCol - pnAddress_Col + 3).Value = lnOldValue
            .Cells(lnCurrRow + 3, lnNumCol - pnAddress_Col + 3).Value = lnNewValue
            .Cells(lnCurrRow + 4, lnNumCol - pnAddress_Col + 3).Value = lcNameItog
            .Cells(lnCurrRow + 5, lnNumCol - pnAddress_Col + 3).Value = lnOldValue - lnNewValue
            .Cells(lnCurrRow + 6, 1).Value = "Необходим дополнительный контроль"
        
    End Select
End With

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