Attribute VB_Name = "INFILE_602"
Option Explicit

Public fName As String

Public Type pageType
            razdelName As String
            grafCount As String
            blankType As Integer
        End Type
Public razdelData() As pageType
Public codeArr() As String, linkArr() As Integer

Public Type codeType
            codeArr() As String
            linkArr() As Integer
        End Type
Public codeData() As codeType, itogStr As Integer, skiped_str As String

Public Sub READ_FROM_FILE()

'myError
Dim StrLine As String, codeForm As String
Dim StrMonth As String, StrYear As String, lbExit As Boolean
Dim lnCodeError As Integer, lcFileName As String, sheetsService As Object, sheetsSEEK_POP_SQLDATA As Object
Dim col, row, corrName, CorrINN, LookRange As Range, Razdel, i
Dim div_flag As Boolean, dep_flag As Boolean, tgt_flag As Boolean, exp_flag As Boolean, code_flag As Boolean      'флаги выгрузки кодов
Dim iFlag As Integer
Dim tempStr As String, str As String
Dim sepCount As Integer

skiped_str = ""
Set sheetsService = Sheets("Service")
Set sheetsSEEK_POP_SQLDATA = Sheets("SQLDATA2")
'прочитаем данные по разделам
ReDim razdelData(sheetsService.Range("B23"))
ReDim codeData(sheetsService.Range("B23"))
'чистим критерий
With sheetsService
    .Range(.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN), .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + KRIT_GRAF_COLUMNCOUNT - 1)) = ""
    .Range(.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 1)) = ""
End With

'Stop

'читаем структуру отчета
For i = 1 To sheetsService.Range("B23")
    sheetsService.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = i
    sheetsService.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN).CALCULATE
    sheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN).CALCULATE
    razdelData(i).razdelName = sheetsService.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN)
    razdelData(i).blankType = sheetsService.Cells(KRIT_RAZDEL_ROW + 4, KRIT_RAZDEL_COLUMN)
    sheetsService.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 2) = i
    sheetsService.Cells(KRIT_GRAF_ROW + 6, KRIT_GRAF_COLUMN).CALCULATE
    razdelData(i).grafCount = sheetsService.Cells(KRIT_GRAF_ROW + 6, KRIT_GRAF_COLUMN) - 1
Next

'Stop

'имя файла
lcFileName = sheetsService.Range("A31")
'добавим в конец "/" (если нет)
i = VBA.Len(lcFileName)
While (VBA.Mid(lcFileName, i, 1) <> "\") And i > 1
    i = i - 1
Wend
fName = VBA.Mid(lcFileName, i + 1, (VBA.Len(lcFileName) - i) - (VBA.Len(lcFileName) - VBA.InStr(i, lcFileName, ".")) - 1)

'запишем общие данные в файл отчета

On Error GoTo closef
eee:
Open sheetsService.Range("B47") + fName + ".Rep" For Output As #2
GoTo rrr
closef:
Close #2
GoTo eee
rrr:
Print #2, "Протокол приема " + sheetsService.Range("B47") + fName + ".Rep"
Print #2, "Форма № " + VBA.Trim(sheetsService.Range("B15")) + "   Дата " + VBA.str(Date) + "  Время " + VBA.str(Time)
Print #2, "Принимаемый файл  " + lcFileName

'pPermitUpd = True ' для заполнения коллекции для сохранения
Sheets("Service").Range("A37").Value = 0
On Error GoTo ERROR_HANDLE
lnCodeError = 2
Open lcFileName For Input As #1
lineNum = 0

' Считываем регион
codeForm = ReadLine()
If (codeForm <> "") And (VBA.Left$(codeForm, 1) <> "*") Then lbExit = False
corrName = codeForm

' Считываем код ОФК
lbExit = True
While lbExit
    StrLine = ReadLine()
    If (StrLine <> "") Then
        If (VBA.InStr(1, StrLine, "=") <> 0) And ((VBA.InStr(1, StrLine, convert_dos_win("УК", 1)) <> 0) Or (VBA.InStr(1, StrLine, "УК") <> 0)) And (VBA.Left(StrLine, 1) <> "*") Then
            lbExit = False
        Else
            skiped_str = skiped_str + StrLine + "  /* ОЖИДАЛСЯ КОД РЕГИОНА */" + vbNewLine
        End If
    End If
Wend
codeForm = StrLine

Print #2, "Корреспондент:  " + convert_dos_win(codeForm + " - " + corrName, 0)

If Not Check_Corr(VBA.Right(codeForm, VBA.Len(codeForm) - VBA.InStr(codeForm, "=")), lnCodeError) Then
    GoTo ERROR_HANDLE
End If

On Error GoTo ERROR_HANDLE

' Дата
lbExit = True
While lbExit
    StrLine = ReadLine()
    If (StrLine <> "") Then
        If (VBA.InStr(1, StrLine, "=") <> 0) And (VBA.InStr(1, StrLine, convert_dos_win("ДТ", 1)) <> 0 Or VBA.InStr(1, StrLine, "ДТ") <> 0) And (VBA.Left(StrLine, 1) <> "*") Then
            lbExit = False
        Else
            skiped_str = skiped_str + StrLine + "  /* ОЖИДАЛАСЬ ДАТА */" + vbNewLine
        End If
    End If
Wend
lbExit = True
'Stop
' Считаем дату
StrYear = VBA.Trim(VBA.Right(VBA.Trim(StrLine), VBA.Len(VBA.Trim(StrLine)) - VBA.InStr(1, VBA.Trim(StrLine), "=", vbTextCompare)))

If Not Formate_date(VBA.Year(StrYear), VBA.Month(StrYear), lnCodeError) Then GoTo ERROR_HANDLE  ' неправильно заполнены месяц и год

Print #2, "Период c " + VBA.Trim(sheetsService.Range("A18")) + " по " + VBA.Trim(sheetsService.Range("A18"))
Print #2, "------------------------------------------------------------"
Print #2, "1. Проверка структуры и заголовка файла"

' Приступаем к считыванию информативной части
corrName = ""
CorrINN = ""
lbExit = True
row = 1

'читаем раздел
While (iFlag <> 1) And (iFlag <> -1)
    StrLine = ReadLine(iFlag)
    If iFlag <> 1 Then skiped_str = skiped_str + StrLine + "  /* ОЖИДАЛСЯ НОМЕР РАЗДЕЛА */" + vbNewLine
Wend

'чистим критерий
With sheetsService
'    .Range(.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN), .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + KRIT_GRAF_COLUMNCOUNT - 1)) = ""
End With

beginLoop:
While iFlag <> -1
        If iFlag = 1 Then 'раздел
            Razdel = VBA.Val(VBA.Right(StrLine, VBA.Len(StrLine) - VBA.InStr(StrLine, "=")))
            If Razdel > sheetsService.Range("B23") Then
                Do
                    StrLine = ReadLine(iFlag)
                Loop While iFlag <> 1 And iFlag <> -1
                GoTo beginLoop
            End If
            ' создадим список кодов для загрузки
            dep_flag = exists_name("DEPARTMENT_" + VBA.Trim(VBA.str(Razdel)))
            div_flag = exists_name("DIVISION_" + VBA.Trim(VBA.str(Razdel)))
            tgt_flag = exists_name("TARGETITEM_" + VBA.Trim(VBA.str(Razdel)))
            exp_flag = exists_name("EXPEND_" + VBA.Trim(VBA.str(Razdel)))
            If dep_flag Then
                code_flag = IIf(Application.Names("DEPARTMENT_" + VBA.Trim(VBA.str(Razdel))).RefersToRange.Column = Application.Names("CODE_STR_" + VBA.Trim(VBA.str(Razdel))).RefersToRange.Column, False, True)
    '            If Not code_flag Then codeColumn = 3
            Else
                code_flag = True
            End If
            sepCount = IIf(dep_flag, 1, 0) + IIf(div_flag, 1, 0) + IIf(tgt_flag, 1, 0) + IIf(exp_flag, 1, 0) + IIf(code_flag, 1, 0) - 1
            'читаем данные
            StrLine = ReadLine(iFlag)
        Else
            skiped_str = skiped_str + StrLine + "  /* ОЖИДАЛСЯ НОМЕР РАЗДЕЛА */" + vbNewLine
            StrLine = ReadLine(iFlag)
        End If
        
        While iFlag = 0  ' (VBA.InStr(1, VBA.Trim(StrLine), "999", vbTextCompare) <> 1) And
             'строка с данными
            If chr_count(StrLine, "|") < razdelData(Razdel).grafCount + sepCount + IIf(sepCount = 0, -1, 0) Then
                skiped_str = skiped_str + StrLine + "  /* НЕВЕРНОЕ ЧИСЛО РАЗДЕЛИТЕЛЕЙ */" + VBA.vbNewLine
            Else
                sheetsSEEK_POP_SQLDATA.Cells(row, 1).Value = Razdel
                sheetsSEEK_POP_SQLDATA.Cells(row, 2).Value = ""
                If Razdel = 2 Then
                    For i = 1 To razdelData(Razdel).grafCount
                        tempStr = getNextSubstr(StrLine, "|")
                        sheetsSEEK_POP_SQLDATA.Cells(row, 7 + i).NumberFormat = "@"
                        sheetsSEEK_POP_SQLDATA.Cells(row, 7 + i) = tempStr
                    Next
                    row = row + 1
                Else
                    str = StrLine
                    If dep_flag Then sheetsSEEK_POP_SQLDATA.Cells(row, 3).Value = getNextSubstr(StrLine, "|")
                    If div_flag Then sheetsSEEK_POP_SQLDATA.Cells(row, 4).Value = getNextSubstr(StrLine, "|")
                    If tgt_flag Then sheetsSEEK_POP_SQLDATA.Cells(row, 5).Value = getNextSubstr(StrLine, "|")
                    If exp_flag Then sheetsSEEK_POP_SQLDATA.Cells(row, 6).Value = getNextSubstr(StrLine, "|")
                    If code_flag Then sheetsSEEK_POP_SQLDATA.Cells(row, 7).Value = getNextSubstr(StrLine, "|")
                    For i = 1 To razdelData(Razdel).grafCount
                        sheetsSEEK_POP_SQLDATA.Cells(row, 7 + i).NumberFormat = "@"
                        tempStr = getNextSubstr(StrLine, "|")
                        If (VBA.Val(tempStr) = 0 And tempStr <> "0.00" And tempStr <> "00.00" And tempStr <> "0") And tempStr <> "" And Not (razdelData(i).blankType = 1) Then  ' не число, или затесались не цифры
                            skiped_str = skiped_str + str + "  /* ОБНАРУЖЕНО НЕЧИСЛОВОЕ ЗНАЧЕНИЕ - " + tempStr + " - записано как 0.00 */" + vbNewLine
                            tempStr = "0.00"
                        End If
                       
                        sheetsSEEK_POP_SQLDATA.Cells(row, 7 + i) = tempStr
                    Next
                    If (sheetsService.Range("A15") = "DOCUMENTS_SVOD_F614" Or sheetsService.Range("A15") = "DOCUMENTS_SVOD_F714" Or sheetsService.Range("A15") = "DOCUMENTS_F614" Or sheetsService.Range("A15") = "DOCUMENTS_F714") And (sheetsSEEK_POP_SQLDATA.Cells(row, 7).Value = "800000") Then
                        skiped_str = skiped_str + str + "  /* ОБНАРУЖЕН КОД, КОТОРЫЙ НЕ ДОЛЖЕН ПРИСУТСТВОВАТЬ В ОТЧЕТЕ - " + sheetsSEEK_POP_SQLDATA.Cells(row, 7).Value + " - СТРОКА ИГНОРИРУЕТСЯ */" + vbNewLine
                    Else
                        row = row + 1
                    End If
                End If
            End If
            StrLine = ReadLine(iFlag)
        Wend
Wend
lExit:
sheetsSEEK_POP_SQLDATA.Cells(row, 1) = ""
Call CLEAR_CONTROL

If skiped_str = "" Then
    Print #2, "- в структуре и заголовке файла ошибок не обнаружено"
Else
    Print #2, "- в структуре и заголовке файла обнаружены ошибки:"
    Print #2, skiped_str
End If
Print #2, "------------------------------------------------------------"

'Stop
Close #1
' Вызов процедуры записи в журнал успешной записи
'Call WRITE_ERROR_MAG(lnCodeError)
' Установка флага конца операции
sheetsService.Range("A59") = 1

If sheetsService.Range("A15") = "DOCUMENTS_SVOD_F614" Or sheetsService.Range("A15") = "DOCUMENTS_SVOD_F714" Or sheetsService.Range("A15") = "DOCUMENTS_F614" Or sheetsService.Range("A15") = "DOCUMENTS_F714" Then Call ADD_ITOG_STR
Exit Sub
ERROR_HANDLE:
If err.number = 62 Then ' ошибка чтения файла (конец файла)
    lnCodeError = 1
    On Error GoTo 0
End If
'Sheets("Контроль").Range("CLEAR_CONTROL").CLEAR
row = Sheets("Контроль").Range("CLEAR_CONTROL").row
col = Sheets("Контроль").Range("CLEAR_CONTROL").Column
Call CLEAR_CONTROL
Select Case lnCodeError
    Case 1
        Sheets("Контроль").Cells(row, col) = "Неожиданный конец файла, строка " + VBA.str(lineNum)
    Case 2
        Sheets("Контроль").Cells(row, col) = "Ошибка в заголовке файла, строка " + VBA.str(lineNum)
    Case 7
        Sheets("Контроль").Cells(row, col) = "Неизвесный корреспондент, строка " + VBA.str(lineNum)
    Case 8
        Sheets("Контроль").Cells(row, col) = "Неверная дата отчета, строка " + VBA.str(lineNum)
    Case 9
        Sheets("Контроль").Cells(row, col) = "Нельзя определить код строки, строка " + VBA.str(lineNum)
    Case 10
        Sheets("Контроль").Cells(row, col) = "Нет разделителя, строка " + VBA.str(lineNum)
    Case 11
        Sheets("Контроль").Cells(row, col) = "Неверный тип данных, строка " + VBA.str(lineNum)
    Case Else
        Sheets("Контроль").Cells(row, col) = "Неизвесная ошибка, строка " + VBA.str(lineNum)
End Select
Print #2, "Ошибка в структуре файла: " + Sheets("Контроль").Cells(row, col)

Sheets("Контроль").Cells(row + 1, col) = "Файл не принят"
Sheets("Контроль").Cells(row + 1, col).Interior.ColorIndex = 3
Close #1
Close #2

' Вызов процедуры записи в журнал об ошибке
'Call WRITE_ERROR_MAG(lnCodeError)
' Установка флага конца операции
sheetsService.Range("A59") = 0
End Sub

' Процедура сохранения отчета на SQL Server при приеме файла
Sub SAVE_REPORT_FROM_FILE()

Dim SqlStr As String, nCnt As Integer, nCountColl As Integer, nCol As Integer, nCount As Integer
Dim metric As Integer, lnDevide As Long
Dim wrkResultSet As DAO.Recordset, lnLinkObject As Integer, lnObject As Integer, link As String, lnRaf As Integer
Dim sheetsService As Object, sheetsReport As Object
Dim DeletedLink As String, lnLink As Long, LookRange As Range, CurrRow As Long
Dim lbExistsValue As Boolean, SqlStr1 As String, SqlStrDel As String
Dim row, col, CorrINN As String, sheetsSEEK_POP_SQLDATA As Object, j
Dim i As Integer, lineCount As Long, codeCol As Integer, _
    bar As Integer, summa(3) As Double, addFlag As Boolean, div, dep, tgt, exp, st As String, sqlStr_raf, lnk, linkCorr, sss, Razdel, saveRow, saveRazdel, ttt As Integer
Dim div_flag As Boolean, dep_flag As Boolean, tgt_flag As Boolean, exp_flag As Boolean, code_flag As Boolean      'флаги выгрузки кодов
Dim struct As String
Dim itog_link As Integer
Dim oldMes As Integer
Dim errorFlag As Boolean

Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
Set sheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Range("B19").Text)
Set sheetsSEEK_POP_SQLDATA = Sheets("SQLDATA2")
' Сохранение документа в зависимости от режима ввода
' 2 - вставка новых записей
' Определим единицу измерения и переведем в копейки
lnDevide = sheetsService.Range("A29").Value

errorFlag = False
' Определим есть ли соединение с сервером
On Error GoTo gggg
If pnwrkConnect = "" Then
    Set pnwrkConnect = Nothing
End If
gggg:
On Error GoTo 0
If pnwrkConnect Is Nothing Then
    Call Server_Connect
End If

Print #2, "5. Сохранение данных файла "

SqlStr = "SELECT LINK FROM S_OBJECTS WHERE CODE='" + VBA.Trim(sheetsService.Range("A15")) + "'"
' выполнени
Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
' получим LINK  объекта
link = VBA.Trim(VBA.str(wrkResultSet("LINK")))

Set wrkResultSet = Nothing

SqlStr = "SELECT LINK FROM REPORTS WHERE OBJECT=" + link + _
             " AND DATE_BEGIN ='" & VBA.Trim(sheetsService.Range("A18")) + "'" + _
             " AND DATE_END ='" & VBA.Trim(sheetsService.Range("A19")) + "'"
' выполнени
Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
' получим LINK  объекта
If wrkResultSet.RecordCount > 0 Then ' отчет есть
    ' Смотрим настройку перезаписи отчета
     If sheetsService.Range("A60") = 1 Then ' перезаписываем отчет
        ' Удаляем его
        ' получим LINK отчета
        SqlStr = "DELETE FROM REPORT_SVOD_DATA WHERE LINK_UP in (select link from report_add_fields where link_up in( select link from reports where object =" + link + _
                 " AND DATE_BEGIN ='" & VBA.Trim(sheetsService.Range("A18")) + "'" + _
                 " AND DATE_END ='" & VBA.Trim(sheetsService.Range("A19")) + "' AND CORR_IN=" + VBA.Trim(sheetsService.Range("A16")) + "))"
        SqlStr = SqlStr & "DELETE FROM REPORT_VALUES WHERE LINK_UP in (select link from reports where object =" + link + _
                 " AND DATE_BEGIN ='" & VBA.Trim(sheetsService.Range("A18")) + "'" + _
                 " AND DATE_END ='" & VBA.Trim(sheetsService.Range("A19")) + "' AND CORR_IN=" + VBA.Trim(sheetsService.Range("A16")) + ")"
        SqlStr = SqlStr & " DELETE FROM REPORT_ADD_FIELDS WHERE LINK_UP in (select link from reports where object =" + link + _
                 " AND DATE_BEGIN ='" & VBA.Trim(sheetsService.Range("A18")) + "'" + _
                 " AND DATE_END ='" & VBA.Trim(sheetsService.Range("A19")) + "' AND CORR_IN=" + VBA.Trim(sheetsService.Range("A16")) + ")"
        SqlStr = SqlStr & " DELETE FROM REPORTS WHERE object =" + link + _
                 " AND DATE_BEGIN ='" & VBA.Trim(sheetsService.Range("A18")) + "'" + _
                 " AND DATE_END ='" & VBA.Trim(sheetsService.Range("A19")) + "' AND CORR_IN=" + VBA.Trim(sheetsService.Range("A16"))
        
        pnwrkConnect.Execute (SqlStr)
     Else
        ' Сделать запись в журнале об существовании отчета
        'Sheets("Контроль").Range("CLEAR_CONTROL").Clear

        Set LookRange = Sheets("Контроль").Range("A2:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
        row = LookRange.row
        Set LookRange = Nothing

        'row = Sheets("Контроль").Range("CLEAR_CONTROL").row
        col = Sheets("Контроль").Range("CLEAR_CONTROL").Column
        Sheets("Контроль").Cells(row + 1, col) = "Данные уже имеются в базе данных"
        Sheets("Контроль").Cells(row + 2, col) = "Данные файла не сохранены"
        Sheets("Контроль").Cells(row + 2, col).Interior.ColorIndex = 3
        
        sheetsService.Range("A59") = 1
        Exit Sub
     End If
End If
  
' Этап 2 вставка новых записей
'Stop
  'найдем линки всех статей
  row = 1
  Razdel = ""
  'имя таблицы 
  sss = "##" + VBA.TRIM(VBA.STR(sheetsService.Range("20")))+ "_" + sheetsService.Range("B15")+Right("00000" + Val(Int(100000 * Rnd())), 5)
  linkCorr = VBA.Trim(sheetsService.Range("A16"))
  While sheetsSEEK_POP_SQLDATA.Cells(row, 1).Text <> ""
        If Razdel <> sheetsSEEK_POP_SQLDATA.Cells(row, 1).Text Then
            If Razdel <> "" Then 'выполнить сохранение
                If Len(SqlStr) <> 0 Then
                    pnwrkConnect.Execute ("EXECUTE A_EXEC '" + SqlStr + "'")
                    SqlStr = ""
                End If
    

                pnwrkConnect.Execute (" EXECUTE V_SAVE_INPUT_DATA " + _
                            IIf(sheetsService.Range("B23") = 1, "0", Razdel) + ", " + _
                            link + "," + _
                            VBA.Trim(linkCorr) + "," + _
                            "'" + VBA.Trim(sheetsService.Range("A18")) + "'," + _
                            "'" + VBA.Trim(sheetsService.Range("A19")) + "'," + _
                            "'" + sss + "', " + VBA.str(razdelData(Razdel).grafCount) + ", " + VBA.str(itog_link))

                
            End If
            Razdel = VBA.Trim(sheetsSEEK_POP_SQLDATA.Cells(row, 1))
            dep_flag = exists_name("DEPARTMENT_" + VBA.Trim(VBA.str(Razdel)))
            div_flag = exists_name("DIVISION_" + VBA.Trim(VBA.str(Razdel)))
            tgt_flag = exists_name("TARGETITEM_" + VBA.Trim(VBA.str(Razdel)))
            exp_flag = exists_name("EXPEND_" + VBA.Trim(VBA.str(Razdel)))
            If dep_flag Then
                code_flag = IIf(Application.Names("DEPARTMENT_" + VBA.Trim(VBA.str(Razdel))).RefersToRange.Column = Application.Names("CODE_STR_" + VBA.Trim(VBA.str(Razdel))).RefersToRange.Column, False, True)
            Else
                code_flag = True
            End If
            
            'создадим таблицу на сервере
            
            SqlStr = "CREATE TABLE " + sss + " (bar Int, dep varchar(3), div varchar(4), tgt varchar(3), exp varchar(3), item varchar(6),link int IDENTITY (1, 1) NOT NULL"
            struct = " ( bar , dep , div , tgt , exp , item "
            For j = 1 To razdelData(Razdel).grafCount
                SqlStr = SqlStr + ", graf_" + VBA.Trim(VBA.str(j)) + " numeric (20,2)"
                struct = struct + ", graf_" + VBA.Trim(VBA.str(j))
            Next
            SqlStr = SqlStr + ")"
            struct = struct + ") values "
        End If
        
    If sheetsSEEK_POP_SQLDATA.Cells(row, 2).Text = "" Then
        st = VBA.Trim(sheetsSEEK_POP_SQLDATA.Cells(row, 7))
        If code_flag Then
            Set LookRange = Sheets(razdelData(Razdel).razdelName).Range("CODE_STR_" + VBA.Trim(VBA.str(Razdel))).Find(st, LookIn:=xlFormulas, lookat:=xlWhole)
        Else
            Set LookRange = Sheets(razdelData(Razdel).razdelName).Range("LINK_" + VBA.Trim(VBA.str(Razdel))).Find(Sheets(razdelData(Razdel).razdelName).Cells(1, 1), LookIn:=xlFormulas, lookat:=xlWhole)
        End If
        If (Not LookRange Is Nothing) Then
            j = row + 1
            bar = VBA.Trim(Sheets(razdelData(Razdel).razdelName).Cells(LookRange.row, 1))
            sheetsSEEK_POP_SQLDATA.Cells(row, 2) = bar
            While sheetsSEEK_POP_SQLDATA.Cells(j, 1).Text = Razdel
                If sheetsSEEK_POP_SQLDATA.Cells(j, 7).Text = st Then sheetsSEEK_POP_SQLDATA.Cells(j, 2) = bar
                j = j + 1
            Wend
            If (VBA.Trim(sheetsSEEK_POP_SQLDATA.Cells(row, 7)) = "800000") Or (Not code_flag) Then
                itog_link = bar
            End If
        Else
            sheetsSEEK_POP_SQLDATA.Cells(row, 2) = 0
            If (st <> "999999") And (VBA.Trim(sheetsSEEK_POP_SQLDATA.Cells(row, 3)) <> "999") Then Print #2, "Неизвестная статья эк. класс. " + st
        End If
    End If
    
    'добавим в табличку sss
    If sheetsSEEK_POP_SQLDATA.Cells(row, 2) <> 0 Then
        SqlStr = SqlStr + " insert " + sss + struct + "(" + sheetsSEEK_POP_SQLDATA.Cells(row, 2).Text + ", ''" + sheetsSEEK_POP_SQLDATA.Cells(row, 3).Text + "'', ''" + sheetsSEEK_POP_SQLDATA.Cells(row, 4).Text + "'', ''" + sheetsSEEK_POP_SQLDATA.Cells(row, 5).Text + "'', ''" + sheetsSEEK_POP_SQLDATA.Cells(row, 6).Text + "'', ''" + sheetsSEEK_POP_SQLDATA.Cells(row, 7).Text + "''"
        For j = 1 To razdelData(Razdel).grafCount
            SqlStr = SqlStr + ", " + VBA.Trim(VBA.str(VBA.Val(sheetsSEEK_POP_SQLDATA.Cells(row, 7 + j)) * lnDevide))
        Next
        SqlStr = SqlStr + ")"
        
        If Len(SqlStr) > 5500 Then
            pnwrkConnect.Execute ("EXECUTE A_EXEC '" + SqlStr + "'")
            SqlStr = ""
        End If
    End If
    row = row + 1
  Wend
  
    If Len(SqlStr) <> 0 Then
       pnwrkConnect.Execute ("EXECUTE A_EXEC '" + SqlStr + "'")
       SqlStr = ""
    End If
    
    pnwrkConnect.Execute (" EXECUTE V_SAVE_INPUT_DATA " + _
                IIf(sheetsService.Range("B23") = 1, "0", Razdel) + ", " + _
                link + "," + _
                VBA.Trim(linkCorr) + "," + _
                "'" + VBA.Trim(sheetsService.Range("A18")) + "'," + _
                "'" + VBA.Trim(sheetsService.Range("A19")) + "'," + _
                "'" + sss + "', " + VBA.str(razdelData(Razdel).grafCount) + ", " + VBA.str(itog_link))
    ' Установка флага конца операции
    sheetsService.Range("A59") = IIf(errorFlag = True, 2, 0)

    Print #2, "------------------------------------------------------------"
End Sub

Sub SVOD_TO_FILE()
'myError
Dim sheetsService As Object
Dim lcFileName As String, lcPath As String, lcShablon As String, _
    lcKodReg As String, lcNumCor  As String, lnRes As Long, lcDay
Dim SqlStr, wrkResultSet, lnDevide, wrkCount, row As Integer, temp, i, rowTemp, Razdel

        Set sheetsService = Sheets("Service")
        lcPath = sheetsService.Range("A54")
        lnDevide = sheetsService.Range("A29").Value

        Call Server_Connect
        SqlStr = "EXECUTE V_GET_OUTPUT_DATA '" + sheetsService.Range("A15") + "', " + VBA.Trim(Sheets("Service").Range("A16").Text) + ",'" + VBA.Trim(Sheets("Service").Range("A18").Text) + "','" + VBA.Trim(Sheets("Service").Range("A19").Text) + "'"

        ' выполнение
        Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
        ' получим LINK  объекта
        If wrkResultSet.EOF = False Then ' данные есть
                ' заполнение таблицы с данными
                wrkCount = 0
                While Not wrkResultSet.EOF
                    If wrkCount <> 0 Then wrkResultSet.MoveNext
                    Sheets("SQLDATA2").Cells(1 + wrkCount * 200, 1).CopyFromRecordset wrkResultSet, 200, wrkResultSet.Fields.count
                    wrkCount = wrkCount + 1
                Wend
                'Sheets("SQLDATA2").Cells(wrkResultSet.RecordCount + 1, 1) = ""
                Sheets("Service").Range("C10") = Replace_in_Str(VBA.Trim(Sheets("Service").Range("C10").Text), "F", "")
        Else
                MsgBox ("Нет данных для пердачи ")
                GoTo errror
        End If
        Set wrkResultSet = Nothing

MetFile:

    lcFileName = sheetsService.Range("B49")
    If sheetsService.Range("B50").Text <> "" Then
            Open sheetsService.Range("B50") For Output As #2
            Call WRITE_TO_FILE(lcFileName)
    Else
            lcDay = WeekDay(Date) - 1
            If lcDay = 0 Then lcDay = 7
            lcFileName = lcPath & VBA.Trim(Sheets("Service").Range("C11").Text) & VBA.Trim(Sheets("Service").Range("C10").Text) & "r1" & VBA.Trim(VBA.str(lcDay))
            Open lcFileName + ".rep" For Output As #2
            Call WRITE_TO_FILE(lcFileName + ".txt")
    End If

'Контроль
Print #2, "Контроль файла для передачи в вышестоящий орган."
'Stop
If (sheetsService.Range("B50").Text <> "") And (sheetsService.Range("A62").Text = "1") Then
        Sheets("Service").Range("A30") = 1
        Call control
Else
        Print #2, "  Файл не контролировался "
End If
errror:
'End If
End Sub


Sub WRITE_TO_FILE(ByVal lcFileName As String)
'myError
Dim sheetsService As Object, sheetsReport As Object, sheetsSEEK_POP_SQLDATA As Object
Dim lcMonth As String, lcYear As String, lcCodeReg As String, lcCodeDoc As String, lcDate As String, _
    lnOutEmptyBars  As Integer, lcLineValue As String, lcCodeStr As String, _
    nCnt As Long, nCntCol As Long, lcValue As String, lnSumma As Double, Razdel As String, row As Long, _
    codeArr() As String, linkArr() As Integer, i As Integer, link As Long, lineCount As Long, codeCol As Integer, _
    bar As String, summa() As Double, addFlag As Boolean, number As String, num As Integer, lnColumn1, lnRow1, colCounter, j
Dim div_flag As Boolean, dep_flag As Boolean, tgt_flag As Boolean, exp_flag As Boolean, code_flag As Boolean      'флаги выгрузки кодов
Dim constStr As String 'постоянная часть строки (99999 999 999 и т.п.)
Dim flag800000 As Boolean 'true - выводить коды 800000
Dim borderCount As Integer
Dim codeColumn As Integer
Dim flag605 As Boolean, subItog605(2, 8) As Double
Dim itogMask As String

On Error GoTo doError

Application.StatusBar = "Подождите ... Идет запись в файл"

Set sheetsService = Sheets("Service")
Set sheetsReport = Sheets(Sheets("Service").Range("B19").Text)
Set sheetsSEEK_POP_SQLDATA = Sheets("SQLDATA2")

Open lcFileName For Output As #1

Call writeHead
row = 1
Razdel = ""

' Формирование информативной части
With sheetsService
     lnColumn1 = KRIT_RAZDEL_COLUMN
     lnRow1 = KRIT_RAZDEL_ROW
     .Range(.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 1)) = ""
End With

lcCodeStr = ""
bar = ""
addFlag = False
'flag800000 = Not (sheetsService.Range("A15") = "DOCUMENTS_SVOD_F614" Or sheetsService.Range("A15") = "DOCUMENTS_SVOD_F714" Or sheetsService.Range("A15") = "DOCUMENTS_F614" Or sheetsService.Range("A15") = "DOCUMENTS_F714")
flag605 = sheetsService.Range("A15") = "DOCUMENTS_SVOD_F605" Or sheetsService.Range("A15") = "DOCUMENTS_SVOD_F705" Or sheetsService.Range("A15") = "DOCUMENTS_F605" Or sheetsService.Range("A15") = "DOCUMENTS_F705"
'codeColumn = 10

'ReDim summa(sheetsService.Range("A10"))

Do While sheetsSEEK_POP_SQLDATA.Cells(row, 1).Text <> ""

    If Razdel <> VBA.Trim(sheetsSEEK_POP_SQLDATA.Cells(row, 1)) Then
    'сменить раздел
        If Razdel <> "" Then
            lcCodeStr = constStr
            For i = 1 To sheetsService.Range("A10")
                lcCodeStr = lcCodeStr + "|" + num_To_Str(summa(i), 16) + " "
                If flag605 Then subItog605(Razdel, i) = summa(i)
            Next
            Print #1, lcCodeStr
            i = 1
        End If
        
        colCounter = 0
        lcCodeStr = ""
        
        'смена раздела
        Razdel = VBA.Trim(sheetsSEEK_POP_SQLDATA.Cells(row, 1))
        
        sheetsService.Cells(lnRow1 + 1, lnColumn1) = Razdel
        If sheetsService.Range("B23") = 1 Then
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Range("B19").Text)
'            Razdel = "0"
        Else
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
        End If
        flag800000 = IIf((sheetsService.Cells(lnRow1 + 7, lnColumn1) = 1) Or (sheetsService.Cells(lnRow1 + 7, lnColumn1) = ""), True, False)
        If sheetsService.Cells(lnRow1 + 6, lnColumn1).Text = "" Then codeColumn = 2 Else codeColumn = sheetsService.Cells(lnRow1 + 6, lnColumn1).Text
        itogMask = sheetsService.Cells(lnRow1 + 8, lnColumn1).Text
        If itogMask = "" Then itogMask = "999999"
        sheetsReport.Activate
        
        bar = sheetsSEEK_POP_SQLDATA.Cells(row, codeColumn)
        
        ReDim summa(sheetsService.Range("A10"))
        
        'смена раздела
        For i = 1 To sheetsService.Range("A10") 'IIf(VBA.Val(Razdel) = 1, 6, 1)
            summa(i) = 0
        Next
        
        ' создадим список кодов для выгрузки
        dep_flag = exists_name("DEPARTMENT_" + IIf(Razdel <> "0", Razdel, "1"))
        div_flag = exists_name("DIVISION_" + IIf(Razdel <> "0", Razdel, "1"))
        tgt_flag = exists_name("TARGETITEM_" + IIf(Razdel <> "0", Razdel, "1"))
        exp_flag = exists_name("EXPEND_" + IIf(Razdel <> "0", Razdel, "1"))
        If dep_flag Then
            code_flag = IIf(sheetsReport.Range("DEPARTMENT_" + IIf(Razdel <> "0", Razdel, "1")).Column = sheetsReport.Range("CODE_STR_" + IIf(Razdel <> "0", Razdel, "1")).Column, False, True)
'            If Not code_flag Then codeColumn = 3
        Else
            code_flag = True
        End If
        
        'итоговая строка
        constStr = IIf(dep_flag, "999 | ", "") + IIf(div_flag, "9999 | ", "") + IIf(tgt_flag, "999 | ", "") + IIf(exp_flag, "999 | ", "") + IIf(code_flag, "999999 | ", "")
        constStr = VBA.Left(constStr, VBA.Len(constStr) - 2)   ' убрали последний разделитель
        
        lineCount = sheetsService.Range("A9") - sheetsService.Range("C5") + 1
        ReDim codeArr(lineCount)
        ReDim linkArr(lineCount)

        codeCol = sheetsReport.Range("CODE_STR").Column
        For i = 1 To lineCount
            link = sheetsReport.Cells(i - 1 + sheetsService.Range("C5"), 1).Value
            If link <> 0 Then
                linkArr(i) = link
                codeArr(i) = VBA.Trim(sheetsReport.Cells(i - 1 + sheetsService.Range("C5"), codeCol))
            End If
        Next
        i = 1
        Call writeRazdel(IIf(Razdel <> "0", VBA.Val(Razdel), 1))
        colCounter = 0
    End If
        
        If dep_flag Then lcCodeStr = sheetsSEEK_POP_SQLDATA.Cells(row, 3).Text + Space(3 - Len(sheetsSEEK_POP_SQLDATA.Cells(row, 3).Text))
        If div_flag Then lcCodeStr = IIf(lcCodeStr <> "", lcCodeStr + " | ", "") + sheetsSEEK_POP_SQLDATA.Cells(row, 4).Text + Space(4 - Len(sheetsSEEK_POP_SQLDATA.Cells(row, 4).Text))
        If tgt_flag Then lcCodeStr = IIf(lcCodeStr <> "", lcCodeStr + " | ", "") + sheetsSEEK_POP_SQLDATA.Cells(row, 5).Text + Space(3 - Len(sheetsSEEK_POP_SQLDATA.Cells(row, 5).Text))
        If exp_flag Then lcCodeStr = IIf(lcCodeStr <> "", lcCodeStr + " | ", "") + sheetsSEEK_POP_SQLDATA.Cells(row, 6).Text + Space(3 - Len(sheetsSEEK_POP_SQLDATA.Cells(row, 6).Text))
        If i > lineCount Then i = 1
        If code_flag And (linkArr(i) <> VBA.Val(bar)) Then
            For i = 1 To lineCount
                If linkArr(i) = VBA.Val(bar) Then
                    lcCodeStr = lcCodeStr + " | " + codeArr(i)
                    GoTo eee
                End If
            Next
        Else
            If linkArr(i) = VBA.Val(bar) Then lcCodeStr = lcCodeStr + " | " + codeArr(i)
        End If
eee:
    sheetsSEEK_POP_SQLDATA.Cells(row, 7) = codeArr(i)
    For j = 1 To sheetsService.Range("A10")
        If sheetsSEEK_POP_SQLDATA.Cells(row, 7 + j) = "" Then
            lcCodeStr = lcCodeStr + " | " + num_To_Str(0, 15)
        Else
            lcCodeStr = lcCodeStr + " | " + num_To_Str(VBA.Val(sheetsSEEK_POP_SQLDATA.Cells(row, 7 + j).Value), 15)
        End If
    Next
    If (codeArr(i) = "800000") Or (Not code_flag) Then
        For j = 1 To sheetsService.Range("A10")
            summa(j) = summa(j) + VBA.Val(sheetsSEEK_POP_SQLDATA.Cells(row, 7 + j).Value)
            If Not flag800000 And code_flag Then lcCodeStr = ""
        Next
    End If
sss:
    If lcCodeStr <> "" Then Print #1, lcCodeStr
    lcCodeStr = ""
    num = num + 1
    row = row + 1
    bar = sheetsSEEK_POP_SQLDATA.Cells(row, codeColumn)
Loop

If lcCodeStr <> "" Then
        Print #1, lcCodeStr
End If

lcCodeStr = constStr
For i = 1 To sheetsService.Range("A10")
    lcCodeStr = lcCodeStr + "|" + num_To_Str(VBA.Val(VBA.str(summa(i))), 16) + " "
    If flag605 Then subItog605(Razdel, i) = summa(i)
Next
Print #1, lcCodeStr

If flag605 Then 'добавим 3-й раздел
    Print #1, ""
    Print #1, convert_dos_win("РД = 3", 1)
    Print #1, ""
    lcCodeStr = "000 |" + num_To_Str(subItog605(1, 1) + subItog605(2, 1), 16) + _
                    " | " + num_To_Str(subItog605(1, 2), 16) + _
                    " | " + num_To_Str(subItog605(1, 3) + subItog605(2, 2), 16) + _
                    " | " + num_To_Str(subItog605(1, 4) + subItog605(2, 3), 16) + _
                    " | " + num_To_Str(subItog605(1, 5), 16) + _
                    " | " + num_To_Str(subItog605(1, 6), 16) + _
                    " | " + num_To_Str(subItog605(1, 7) + subItog605(2, 4), 16) + _
                    " | " + num_To_Str(subItog605(1, 8), 16)
    Print #1, lcCodeStr
End If
' Формирование заключительной части
Print #1, ""
Print #1, "#"
Print #1, convert_dos_win(sheetsService.Range("A50"), 1)
Print #1, convert_dos_win(sheetsService.Range("A51"), 1)
Close #1
Application.StatusBar = False
Exit Sub
doError:
    Call ERROR_EVENT("WRITE_TO_FILE")
End Sub

Sub control_999()

Dim LookRange As Range, rowControl, colControl, errorFlag As Boolean
Dim corr As String, rowData, sheetsSQLDATA2 As Object, SqlStr, sum(6) As Double
Dim wrkResultSet As DAO.Recordset, flag, i, hWnd, err1 As String, err2 As String, err3 As String
Dim Razdel As Integer
    
'hWnd = FindWindow("XLMAIN", 0)
'LockWindowUpdate (hWnd)
    'Stop
    errorFlag = False
    Set sheetsSQLDATA2 = Sheets("SQLDATA2")
    Set LookRange = Sheets("Контроль").Range("A2:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
    rowControl = LookRange.row
    Set LookRange = Nothing
    colControl = Sheets("Контроль").Range("CLEAR_CONTROL").Column
    Sheets("Контроль").Cells(rowControl, colControl) = "Проверка контрольных сумм"
    Sheets("Контроль").Cells(rowControl, colControl).Interior.ColorIndex = 6
    rowControl = rowControl + 1
    
    Print #2, "3. Анализ соответствия итоговых сумм"
    
    rowData = 1
    corr = ""
    For i = 1 To 6
        sum(i) = 0
    Next
    
'    Stop
    Razdel = sheetsSQLDATA2.Cells(rowData, 1)
    While VBA.Trim(sheetsSQLDATA2.Cells(rowData, 1)) <> ""
            If VBA.Trim(sheetsSQLDATA2.Cells(rowData, 7)) = "999999" Then
                flag = False
                For i = 1 To razdelData(sheetsSQLDATA2.Cells(rowData, 1)).grafCount
                    If Abs(sum(i) - VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i))) > 0.00001 Then
                        Sheets("Контроль").Cells(rowControl + 1, colControl + 1 + i) = VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i))
                        Sheets("Контроль").Cells(rowControl + 2, colControl + 1 + i) = sum(i)
                        Sheets("Контроль").Cells(rowControl + 3, colControl + 1 + i) = sum(i) - VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i))
                        
                        err1 = err1 + "   " + Space(15 - VBA.Len(VBA.Format(VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i)), "###0.00"))) + VBA.Format(VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i)), "###0.00")
                        err2 = err2 + "   " + Space(15 - VBA.Len(VBA.Format(sum(i), "###0.00"))) + VBA.Format(sum(i), "###0.00")
                        err3 = err3 + "   " + Space(15 - VBA.Len(VBA.Format(sum(i) - VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i)), "###0.00"))) + VBA.Format(sum(i) - VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i)), "###0.00")
                        
                        flag = True
                    End If
                    
                    sum(i) = 0
                Next
                If flag Then
                    Sheets("Контроль").Cells(rowControl, colControl) = "Строка " + VBA.Trim(sheetsSQLDATA2.Cells(rowData, 1))
                    Sheets("Контроль").Cells(rowControl + 1, colControl) = "Введено     "
                    Sheets("Контроль").Cells(rowControl + 2, colControl) = "Расчитано   "
                    Sheets("Контроль").Cells(rowControl + 3, colControl) = "Расхождение "
                    
                    Print #2, " - раздел """ + VBA.Trim(razdelData(sheetsSQLDATA2.Cells(rowData, 1)).razdelName) + """"
                    
                    Print #2, "  " + Sheets("Контроль").Cells(rowControl + 1, colControl) + err1
                    Print #2, "  " + Sheets("Контроль").Cells(rowControl + 2, colControl) + err2
                    Print #2, "  " + Sheets("Контроль").Cells(rowControl + 3, colControl) + err3
                    
                    rowControl = rowControl + 4
                    errorFlag = True
                End If
            Else
                For i = 1 To razdelData(sheetsSQLDATA2.Cells(rowData, 1)).grafCount
                    If VBA.Trim(sheetsSQLDATA2.Cells(rowData, 7)) = "800000" Then
                        sum(i) = sum(i) + VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i))
                    End If
                Next
            End If
            
'        End If
        If Razdel <> sheetsSQLDATA2.Cells(rowData, 1) Then
            flag = False
            For i = 1 To razdelData(sheetsSQLDATA2.Cells(rowData, 1)).grafCount
                If sum(i) <> 0 Then flag = True
                sum(i) = 0
            Next
            If flag Then
                Print #2, "   отсутствует строка с итоговыми значениями - раздел """ + VBA.Trim(razdelData(sheetsSQLDATA2.Cells(rowData, 1)).razdelName) + """"
                errorFlag = True
            End If
            Razdel = sheetsSQLDATA2.Cells(rowData, 1)
        End If
        rowData = rowData + 1
    Wend
    
    flag = False
    For i = 1 To razdelData(Razdel).grafCount
        If sum(i) <> 0 Then flag = True
    Next
    If flag Then
        Print #2, "   отсутствует строка с итоговыми значениями - раздел """ + VBA.Trim(razdelData(Razdel).razdelName) + """"
        errorFlag = True
    End If
    ' Установка флага конца операции
    If errorFlag Then
        Sheets("Service").Range("A59") = 1
        Print #2, " - обнаружены несоответствия контрольных сумм "
    Else
        Sheets("Service").Range("A59") = 0
        Print #2, " - несоответствия контрольных сумм не обнаружены "
    End If
    
    Print #2, "------------------------------------------------------------"

'LockWindowUpdate (0)
End Sub

Sub control()
'myError
Dim sheetsService As Object, sheetsReport As Object
Dim DeletedLink As String, lnLink As Long, LookRange As Range, CurrRow As Long
Dim lbExistsValue As Boolean, SqlStr1 As String, SqlStrDel As String
Dim row, col, Razdel As String, sheetsSQLDATA2 As Object
Dim codeArr() As String, linkArr() As Integer, i As Integer, lineCount As Long, codeCol As Integer, _
    bar As Integer, summa(3) As Double, addFlag As Boolean, div, dep, tgt, exp, sqlStr_raf, lnk, linkCorr, sss, _
    errorFlag As Boolean, colControl, hWnd, j

'hWnd = FindWindow("XLMAIN", 0)
'LockWindowUpdate (hWnd)

'Stop
    Print #2, "4. Контроль по контрольным соотношениям"
'    Stop
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    'Set sheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Range("B19").Text)
    Set sheetsSQLDATA2 = Sheets("SQLDATA2")
    colControl = Sheets("Контроль").Range("CLEAR_CONTROL").Column
    
    
    errorFlag = False
    
    div = sheetsSQLDATA2.Cells(1, 3)
    dep = sheetsSQLDATA2.Cells(1, 4)
    tgt = sheetsSQLDATA2.Cells(1, 5)
    exp = sheetsSQLDATA2.Cells(1, 6)
    OldBK = div + ", " + dep + ", " + tgt + ", " + exp

    Razdel = sheetsSQLDATA2.Cells(1, 1)
    OldRazdel = Razdel
    'выбор раздела
    With sheetsService
        .Range(.Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN), .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + KRIT_RAZDEL_COLUMNCOUNT - 1)) = ""
        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = VBA.Trim(IIf(Razdel = 0, 1, Razdel))
        .Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN).CALCULATE
        Worksheets(VBA.Trim(.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN))).Activate
        Set sheetsReport = Sheets(VBA.Trim(.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN)))
        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = ""
    End With
    row = 1
    
    lineCount = sheetsService.Range("A9") - sheetsService.Range("C5") + 1
    ReDim codeArr(lineCount)
    ReDim linkArr(lineCount)
    
    codeCol = sheetsReport.Range("CODE_STR").Column
    For i = 1 To lineCount
        lnk = sheetsReport.Cells(i - 1 + sheetsService.Range("C5"), 1).Value
        If lnk <> 0 Then
            linkArr(i) = i - 1 + sheetsService.Range("C5")
            codeArr(i) = VBA.Trim(sheetsReport.Cells(i - 1 + sheetsService.Range("C5"), codeCol))
            If codeArr(i) = "800000" Then itogStr = linkArr(i)
        End If
    Next
    
    sheetsService.Range("A37") = 1
'    Sheets("Контроль").Visible = True
    sheetsReport.Range("MAIN_DATA") = ""
    GoTo rrr
    Do While sheetsSQLDATA2.Cells(row, 1).Text <> ""
    
        If (Razdel <> sheetsSQLDATA2.Cells(row, 1)) _
            Or (div <> sheetsSQLDATA2.Cells(row, 3)) _
            Or (dep <> sheetsSQLDATA2.Cells(row, 4)) _
            Or (tgt <> sheetsSQLDATA2.Cells(row, 5)) _
            Or (exp <> sheetsSQLDATA2.Cells(row, 6)) _
        Then ' создать запись
            If sheetsSQLDATA2.Cells(row, 7) <> "999999" Then
                If Razdel <> sheetsSQLDATA2.Cells(row, 1) Then
                    'смена листа
                    With sheetsService
                        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = VBA.Trim(sheetsSQLDATA2.Cells(row, 1))
                        Worksheets(VBA.Trim(.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN))).Activate
                        Set sheetsReport = Sheets(VBA.Trim(.Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN)))
                        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = ""
                        
                        lineCount = sheetsService.Range("A9") - sheetsService.Range("C5") + 1
                        ReDim codeArr(lineCount)
                        ReDim linkArr(lineCount)
                        For i = 1 To lineCount
                            lnk = sheetsReport.Cells(i - 1 + sheetsService.Range("C5"), 1).Value
                            If lnk <> 0 Then
                                linkArr(i) = i - 1 + sheetsService.Range("C5")
                                codeArr(i) = VBA.Trim(sheetsReport.Cells(i - 1 + sheetsService.Range("C5"), codeCol))
                                If codeArr(i) = "800000" Then itogStr = linkArr(i)
                            End If
                        Next
                        
                    End With
                    
                    Call addHead
                    Razdel = sheetsSQLDATA2.Cells(row, 1)
                    OldRazdel = Razdel
                End If
                Set LookRange = Sheets("Контроль").Range("A2:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
                Sheets("Контроль").Cells(LookRange.row, colControl) = "Контроль раздела " + Razdel + ", подраздел " + div + ", ведомство " + dep + ", цел. статья " + tgt + ", вид расхода " + exp
                Sheets("Контроль").Range(Sheets("Контроль").Cells(LookRange.row, colControl), Sheets("Контроль").Cells(LookRange.row, colControl + 4)).Interior.ColorIndex = 6
                
                Application.Names.Add name:="CODE_STR_CONTROL", RefersTo:="=Контроль!$B$" + VBA.Trim(VBA.str(LookRange.row + 1)) + ":$B$60000"
                
                Set LookRange = Nothing
                
                Call CONTROL_PAGE_FROM_FILE
                If sheetsService.Range("A59") = 0 Then
                    errorFlag = True
                End If
                
                sheetsReport.Range("MAIN_DATA") = ""
                'sheetsReport.Range("MAIN_DATA").Interior.ColorIndex = xlColorIndexAutomatic
                'Razdel = sheetsSQLDATA2.Cells(row, 1)
                div = sheetsSQLDATA2.Cells(row, 3)
                dep = sheetsSQLDATA2.Cells(row, 4)
                tgt = sheetsSQLDATA2.Cells(row, 5)
                exp = sheetsSQLDATA2.Cells(row, 6)
                OldBK = div + ", " + dep + ", " + tgt + ", " + exp

                GoTo rrr
            End If
        Else
rrr:
        If sheetsSQLDATA2.Cells(row, 7) = "" Then sheetsSQLDATA2.Cells(row, 7) = sheetsSQLDATA2.Cells(row - 1, 7)
        For i = 1 To lineCount
            If codeArr(i) = VBA.Trim(sheetsSQLDATA2.Cells(row, 7)) Then
                For j = 1 To sheetsService.Range("A10")
                    sheetsReport.Cells(linkArr(i), sheetsService.Range("C6") + j - 1).Value = VBA.Val(sheetsSQLDATA2.Cells(row, 7 + j))
                Next
                If codeArr(i) <> "800000" Then pUPDColl(Razdel).Add (VBA.str(linkArr(i)))
                GoTo ttt
            End If
        Next
ttt:
        End If
        row = row + 1
    Loop
    
     Set LookRange = Sheets("Контроль").Range("A2:A60000").Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
    Sheets("Контроль").Cells(LookRange.row, colControl) = "Контроль раздела " + Razdel + ", подраздел " + div + ", ведомство " + dep + ", цел. статья " + tgt + ", вид расхода " + exp
    Sheets("Контроль").Range(Sheets("Контроль").Cells(LookRange.row, colControl), Sheets("Контроль").Cells(LookRange.row, colControl + 4)).Interior.ColorIndex = 6
    
    Application.Names.Add name:="CODE_STR_CONTROL", RefersTo:="=Контроль!$B$" + VBA.Trim(VBA.str(LookRange.row + 1)) + ":$B$60000"
    
    Set LookRange = Nothing
   
    Call CONTROL_PAGE_FROM_FILE
    If sheetsService.Range("A59") = 0 Then
        errorFlag = True
    End If
    
    Print #2, ""
    ' Установка флага конца операции
    If errorFlag Then
        Sheets("Service").Range("A59") = 1
        Print #2, " - обнаружены ошибки контроля "
    Else
        Sheets("Service").Range("A59") = 0
        Print #2, " - ошибок контроля не обнаружено "
    End If
    
    Print #2, "------------------------------------------------------------"
   
'LockWindowUpdate (0)
End Sub

Sub after_output_f605()
'добавляет итоговые строки (80000) для форм 614(714) в SQLDATA2
End Sub

Sub ADD_ITOG_STR()
Dim sum(3) As Double, rowData As Integer, sheetsSQLDATA2, flag As Boolean
Dim c1 As String, c2 As String, c3 As String, c4 As String, Razdel As Integer, i As Integer

    rowData = 1
    For i = 1 To 3
        sum(i) = 0
    Next
    
    'Stop
    Set sheetsSQLDATA2 = Sheets("SQLDATA2")
    
    'читаем текущую БК
    c1 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 3))
    c2 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 4))
    c3 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 5))
    c4 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 6))
    Razdel = sheetsSQLDATA2.Cells(rowData, 1)
    
    While (VBA.Trim(sheetsSQLDATA2.Cells(rowData, 1)) <> "")
            If (c1 <> VBA.Trim(sheetsSQLDATA2.Cells(rowData, 3))) Or _
                (c2 <> VBA.Trim(sheetsSQLDATA2.Cells(rowData, 4))) Or _
                (c3 <> VBA.Trim(sheetsSQLDATA2.Cells(rowData, 5))) Or _
                (c4 <> VBA.Trim(sheetsSQLDATA2.Cells(rowData, 6))) Or _
                (Razdel <> sheetsSQLDATA2.Cells(rowData, 1)) Then
                    If Razdel = sheetsSQLDATA2.Cells(rowData, 1) Then
                        sheetsSQLDATA2.Rows(rowData).Insert
                        sheetsSQLDATA2.Cells(rowData, 3) = c1
                        sheetsSQLDATA2.Cells(rowData, 4) = c2
                        sheetsSQLDATA2.Cells(rowData, 5) = c3
                        sheetsSQLDATA2.Cells(rowData, 6) = c4
                        sheetsSQLDATA2.Cells(rowData, 7) = "800000"
                        sheetsSQLDATA2.Cells(rowData, 1) = Razdel
                        
                        For i = 1 To IIf(Razdel = 1, 3, 1)
                            sheetsSQLDATA2.Cells(rowData, 7 + i) = VBA.str(sum(i))
                            sum(i) = 0
                        Next
                        rowData = rowData + 1
                    End If
                        
                        Razdel = sheetsSQLDATA2.Cells(rowData, 1)
                        c1 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 3))
                        c2 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 4))
                        c3 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 5))
                        c4 = VBA.Trim(sheetsSQLDATA2.Cells(rowData, 6))
                        GoTo sss
                Else
sss:
                    If VBA.Trim(sheetsSQLDATA2.Cells(rowData, 7)) <> "999999" Then
                        For i = 1 To IIf(Razdel = 1, 3, 1)
                            sum(i) = sum(i) + VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i))
                        Next
                    End If
                End If
        rowData = rowData + 1
    Wend

'    stop
    If VBA.Trim(sheetsSQLDATA2.Cells(rowData - 1, 7)) <> "999999" And VBA.Trim(sheetsSQLDATA2.Cells(rowData - 1, 7)) <> "800000" Then
        sheetsSQLDATA2.Cells(rowData, 3) = c1
        sheetsSQLDATA2.Cells(rowData, 4) = c2
        sheetsSQLDATA2.Cells(rowData, 5) = c3
        sheetsSQLDATA2.Cells(rowData, 6) = c4
        sheetsSQLDATA2.Cells(rowData, 7) = "800000"
        sheetsSQLDATA2.Cells(rowData, 1) = Razdel
        For i = 1 To IIf(Razdel = 1, 3, 1)
            sheetsSQLDATA2.Cells(rowData, 7 + i) = VBA.str(sum(i))
            sum(i) = 0
        Next
        rowData = rowData + 1
    End If
    sheetsSQLDATA2.Cells(rowData, 1) = ""
End Sub



