Attribute VB_Name = "INFILE_KREDIT"
Option Explicit

Public fName As String

Public Type pageType
            razdelName As String
            grafCount As String
        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, dataLinesCount As Integer, footerLinesCount As Integer, borderCount As Integer

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, sheetsInOutFile As Object
Dim col, row, corrName, CorrINN, LookRange As Range, Razdel, i, j
Dim iFlag As Integer
Dim tempStr As String, str As String
Dim sepCount As Integer
Dim kritRow As Integer, kritCol As Integer, kritColCount As Integer
Dim codeArr() As String
Dim cNumOtch As String, kodReg As String, kodOtd As String, dateRep As String

Call msgBox("Этот режим находится на стадии разработки")
exit sub

Set sheetsService = Sheets("Service")
Set sheetsInOutFile = Sheets("Передача")
'прочитаем данные по разделам

'имя файла заголовка
lcFileName = sheetsInOutFile.Range("HEAD_IN_OUT_FILE_NAME")
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)
lcFileName = sheetsService.Range("B47") + lcFileName

'запишем общие данные в файл отчета
Open sheetsService.Range("B47") + fName + ".REP" For Output As #2
Print #2, "Протокол приема " + sheetsService.Range("B47") + fName + ".REP" ' + sheetsService.Range("A50")
Print #2, "Форма № " + VBA.Trim(sheetsService.Range("B15")) + "   Дата " + VBA.str(Date) + "  Время " + VBA.str(Time)
Print #2, ""
Print #2, "Прием файла заголовка " + lcFileName

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

kritRow = sheetsInOutFile.Range("HEAD_IN_OUT").row
kritCol = sheetsInOutFile.Range("HEAD_IN_OUT").Column
kritColCount = sheetsInOutFile.Range("HEAD_IN_OUT").Columns.count

ReDim codeArr(kritColCount)
'читаем строку кода
iFlag = 0
readHead:
str = ReadLine(iFlag)
If (chr_count(str, vbTab) <> kritColCount - 1) And (iFlag <> -1) Then
    skiped_str = skiped_str + str + "  /* НЕВЕРНОЕ ЧИСЛО РАЗДЕЛИТЕЛЕЙ */" + VBA.Chr(13)
    GoTo readHead
Else
    If iFlag = -1 Then
        lnCodeError = 1
        GoTo ERROR_HANDLE
    Else
        lbExit = False
        For i = 1 To kritColCount
            tempStr = getNextSubstr(str, vbTab)
            If tempStr <> VBA.Trim(sheetsInOutFile.Cells(kritRow + 3, kritCol + i - 1)) Then
                lbExit = True
                skiped_str = skiped_str + " НЕВЕРНЫЙ КОД ПОЛЯ - """ + tempStr + """ (ОЖИДАЛОСЬ """ + VBA.Trim(sheetsInOutFile.Cells(kritRow + 3, kritCol + i - 1)) + """)" + VBA.Chr(13)
            Else
                codeArr(i) = tempStr
            End If
        Next
        If lbExit Then
            lnCodeError = 99
            GoTo ERROR_HANDLE
        End If
    End If
End If

'читаем строку данных
iFlag = 0
dataHead:
str = ReadLine(iFlag)
If (chr_count(str, vbTab) <> kritColCount - 1) And (iFlag <> -1) Then
    skiped_str = skiped_str + str + "  /* НЕВЕРНОЕ ЧИСЛО РАЗДЕЛИТЕЛЕЙ */" + VBA.Chr(13)
    GoTo dataHead
Else
    If iFlag = -1 Then
        lnCodeError = 1
        GoTo ERROR_HANDLE
    Else
        lbExit = False
        For i = 1 To kritColCount
            tempStr = getNextSubstr(str, vbTab)
            sheetsInOutFile.Cells(kritRow + 4, kritCol + i - 1) = convert_dos_win(tempStr, 0)
            
            If codeArr(i) = "NUM_OTCH" Then
                cNumOtch = convert_dos_win(tempStr, 0)
            End If
            If codeArr(i) = "KOD_REG1" Then
                kodReg = convert_dos_win(tempStr, 0)
            End If
            If codeArr(i) = "KOD_OTD" Then
                kodOtd = convert_dos_win(tempStr, 0)
            End If
            If codeArr(i) = "DAT_OTCH" Then
                dateRep = convert_dos_win(tempStr, 0)
            End If
        Next
    End If
End If

'инициализация данных
If VBA.Left(cNumOtch, 4) = kodReg & kodOtd Then
    If Not Check_Corr(kodReg & kodOtd, lnCodeError) Then GoTo ERROR_HANDLE
Else
    skiped_str = skiped_str + "  НЕСООТВЕТСТВИЕ КОДОВ ОТПРАВИТЕЛЯ ФАЙЛА : NUM_OTCH = " + VBA.Left(cNumOtch, 4) + ", KOD_REG1 = " + kodReg + ", KOD_OTD = " + kodOtd + VBA.Chr(13)
    lnCodeError = 7
    GoTo ERROR_HANDLE
End If

lnCodeError = 8
tempStr = dateRep
dateRep = VBA.DateAdd("Y", -1, dateRep)
If VBA.Val(VBA.Month(dateRep)) = VBA.Val(VBA.Mid(cNumOtch, 7, 2)) And VBA.Val(VBA.Right(VBA.Trim(VBA.str(VBA.Year(dateRep))), 2)) = VBA.Val(VBA.Mid(cNumOtch, 9, 2)) Then
    If Not Formate_date(VBA.Year(tempStr), VBA.Month(tempStr), lnCodeError) Then GoTo ERROR_HANDLE
Else
    skiped_str = skiped_str + "  НЕСООТВЕТСТВИЕ ДАТ ОТЧЕТА : NUM_OTCH = " + VBA.Mid(cNumOtch, 7, 4) + ", DAT_OTCH = " + tempStr + VBA.Chr(13)
    lnCodeError = 8
    GoTo ERROR_HANDLE
End If

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

'имя файла заголовка
lcFileName = sheetsService.Range("B47") + sheetsInOutFile.Range("DATA_IN_OUT_FILE_NAME")
Print #2, "Прием файла данных " + lcFileName
On Error GoTo ERROR_HANDLE
lnCodeError = 2
Open lcFileName For Input As #1

kritRow = sheetsInOutFile.Range("DATA_IN_OUT").row
kritCol = sheetsInOutFile.Range("DATA_IN_OUT").Column
kritColCount = sheetsInOutFile.Range("DATA_IN_OUT").Columns.count

'читаем строку кода
iFlag = 0
readDATA:
str = ReadLine(iFlag)
If (chr_count(str, vbTab) <> kritColCount - 1) And (iFlag <> -1) Then
    skiped_str = skiped_str + str + "  /* НЕВЕРНОЕ ЧИСЛО РАЗДЕЛИТЕЛЕЙ */" + VBA.Chr(13)
    GoTo readDATA
Else
    If iFlag = -1 Then
        lnCodeError = 1
        GoTo ERROR_HANDLE
    Else
        lbExit = False
        For i = 1 To kritColCount
            tempStr = getNextSubstr(str, vbTab)
            If tempStr <> VBA.Trim(sheetsInOutFile.Cells(kritRow + 3, kritCol + i - 1)) Then
                lbExit = True
                skiped_str = skiped_str + " НЕВЕРНЫЙ КОД ПОЛЯ - """ + tempStr + """ (ОЖИДАЛОСЬ """ + VBA.Trim(sheetsInOutFile.Cells(kritRow + 3, kritCol + i - 1)) + """)" + VBA.Chr(13)
            End If
        Next
        If lbExit Then
            lnCodeError = 99
            GoTo ERROR_HANDLE
        End If
    End If
End If

'читаем строку данных
iFlag = 0
data:
str = ReadLine(iFlag)
If (chr_count(str, vbTab) <> kritColCount - 1) And (iFlag <> -1) Then
    skiped_str = skiped_str + str + "  /* НЕВЕРНОЕ ЧИСЛО РАЗДЕЛИТЕЛЕЙ */" + VBA.Chr(13)
    GoTo data
Else
    If iFlag = -1 Then
        GoTo lExit
    Else
        lbExit = False
        For i = 1 To kritColCount
            tempStr = getNextSubstr(str, vbTab)
            sheetsInOutFile.Cells(kritRow + 4, kritCol + i - 1) = convert_dos_win(tempStr, 0)
        Next
        kritRow = kritRow + 1
        GoTo data
    End If
End If

lExit:

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

'Stop
Close #1
Close #2

Call FILL_REP_FROM_IN_OUT_PAGE

' Вызов процедуры записи в журнал успешной записи
'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 99
        Sheets("Контроль").Cells(row, col) = ""
    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 lnDevide As Integer
Dim wrkResultSet As DAO.Recordset, lnLinkObject As Integer, lnObject 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 lnColumn1, lnRow1, row11, col11, i, j, row, col, BLANK

Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
Set sheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Range("B19").Text)
' Сохранение документа в зависимости от режима ввода
' 2 - вставка новых записей
' Определим единицу измерения и переведем в копейки
lnDevide = sheetsService.Range("A29").Value
' Определим есть ли соединение с сервером
If pnwrkConnect Is Nothing Then
    Call Server_Connect
End If
SqlStr = "SELECT LINK FROM REPORTS WHERE OBJECT = " & VBA.Trim(VBA.str(sheetsService.Range("A14"))) + _
             " AND CORR_IN =" & VBA.Trim(VBA.str(sheetsService.Range("A16"))) + _
             " 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 отчета
        lnLinkObject = VBA.Trim(VBA.str(wrkResultSet("LINK")))
        SqlStr = "DELETE FROM REPORT_VALUES_STR WHERE LINK_UP IN (" + _
                 "SELECT LINK FROM REPORT_VALUES WHERE LINK_UP=" + VBA.Trim(VBA.str(lnLinkObject)) + _
                 " AND VALUE is NULL" + " )"
        pnwrkConnect.Execute (SqlStr)
        
        SqlStr = "DELETE FROM REPORT_VALUES WHERE LINK_UP = " + VBA.Trim(VBA.str(lnLinkObject))
        SqlStr = SqlStr & " DELETE FROM REPORTS WHERE LINK = " + VBA.Trim(VBA.str(lnLinkObject))
        pnwrkConnect.Execute (SqlStr)
     Else
        Set LookRange = Sheets("Контроль").Range("A5: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
    Exit Sub ' Сделать запись в журнале об существовании отчета
     End If
End If
lnLinkObject = sheetsService.Range("A14")
' вставим запись в table Reports
SqlStr = "INSERT REPORTS (OBJECT,CORR_IN,CORR_OUT,DATE_BEGIN,DATE_END,USERS) VALUES (" + _
            VBA.Trim(VBA.str(lnLinkObject)) + "," + _
            VBA.Trim(VBA.str(sheetsService.Range("A16"))) + "," + _
            "NULL" + "," + _
            "'" + VBA.Trim(sheetsService.Range("A18")) + "'," + _
            "'" + VBA.Trim(sheetsService.Range("A19")) + "', NULL)"
' выполнение insert на SQL server
  Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
' получим LINK вновь вставленного объекта
  lnObject = VBA.Trim(VBA.str(wrkResultSet("LINK")))
  Set wrkResultSet = Nothing


With sheetsService.Range("KRIT_RAZDEL")
     lnColumn1 = .Column
     lnRow1 = .row
End With

row11 = sheetsService.Range("KRIT_GRAF").row
col11 = sheetsService.Range("KRIT_GRAF").Column

For i = 1 To sheetsService.Range("B23")
    ' установим страницу
    ' зададим критерий
    sheetsService.Cells(lnRow1 + 1, lnColumn1) = i
    If sheetsService.Range("B23") = 1 Then
        Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Range("B19").Text)
    Else
        Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
    End If
    BLANK = sheetsService.Cells(lnRow1 + 4, lnColumn1)

    sheetsReport.Activate
    
    ReDim str_status(sheetsService.Range("A10"))
    
    For j = 1 To sheetsService.Range("A10").Value
    'критерий для колонок с данными
        sheetsService.Cells(row11 + 1, col11) = j
        sheetsService.Cells(row11 + 1, col11 + 1) = ""
        str_status(j) = sheetsService.Cells(row11 + 4, col11).Value
    Next
    With ThisWorkbook.Sheets("Service")
        pnAddress_Row = .Range("C5")
        pnAddress_Col = .Range("C6")
    End With
    
    
' Этап 2 вставка новых записей
    SqlStr = ""
    nCountColl = pINSColl(i).count
    If nCountColl > 0 Then 'есть записи для вставки
        For nCnt = 1 To nCountColl
            SqlStr1 = ""
            lnLink = pINSColl(i)(nCnt)
            Set LookRange = sheetsReport.Range("LINK").Find(lnLink, LookIn:=xlFormulas, lookat:=xlWhole)
            If Not LookRange Is Nothing Then
                CurrRow = LookRange.row
                lbExistsValue = False
                'If str_status(nCnt) = 0 Then
                    For nCol = 0 To sheetsService.Range("A10") - 1
                            If str_status(nCol + 1) = 0 Then
                                SqlStr1 = SqlStr1 + " INSERT REPORT_VALUES (LINK_UP,OBJECT,BARS,GRAFS,VALUE) VALUES(" + _
                                VBA.Trim(VBA.str(lnObject)) + "," + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + "," + _
                                VBA.Trim(VBA.str(lnLink)) + "," + _
                                VBA.Trim(VBA.str(nCol + 1)) + "," + _
                                VBA.Trim(VBA.str(sheetsReport.Cells(CurrRow, IIf(BLANK = 0, pnAddress_Col, 3) + nCol).Value * lnDevide)) + ")"
                                ' Проверка на наличия значений
                                If sheetsReport.Cells(CurrRow, IIf(BLANK = 0, pnAddress_Col, 3) + nCol).Value <> 0 Then
                                    lbExistsValue = True
                                End If
                            Else
                                SqlStr1 = SqlStr1 + " EXECUTE V_ADD_REPORT_VALUES " + _
                                            VBA.Trim(VBA.str(lnObject)) + "," + _
                                            IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + "," + _
                                            VBA.Trim(VBA.str(lnLink)) + "," + _
                                            VBA.str(nCol + 1) + "," + _
                                            "NULL" + "," + _
                                            "'" + sheetsReport.Cells(CurrRow, IIf(BLANK = 0, pnAddress_Col, 3) + nCol).Text + "'"
                               
                                ' Проверка на наличия значений
                                If sheetsReport.Cells(CurrRow, pnAddress_Col + nCol).Text <> "" Then
                                    lbExistsValue = True
                                End If
                                
                          
                            End If
                    Next
                'End If
                'если все значения = 0 то не записываем
                If lbExistsValue Then
                    SqlStr = SqlStr + SqlStr1
                    lbExistsValue = False
                    ' Заносим в коллекцию уже существующих
                    'pNotEmptyColl(i).Add lnLink, VBA.Trim(VBA.str(lnLink))
                End If
                'Сформируем строку insert на SQL Server
                ' Проверим пакет
                If VBA.Len(SqlStr) > 300000 Then
                    ' Выполняем пакет команд
                    pnwrkConnect.Execute (SqlStr)
                    SqlStr = ""
                End If
            End If
        Next
       ' Удаление из коллекции
        For nCnt = 1 To pINSColl(i).count
            pINSColl(i).Remove (1)
        Next
        'Выполним оставшиеся insert на SQL Server
        If SqlStr <> "" Then
            pnwrkConnect.Execute (SqlStr)
        End If
    End If
Next
sheetsService.Cells(lnRow1 + 1, lnColumn1) = ""
' Установка флага конца операции
sheetsService.Range("A59") = 0
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, LookRange As Range, ToolbarAction

'    Stop
    Call FILL_IN_OUT_PAGE

    Set ToolbarAction = CommandBars("Редактор")
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
        .FaceId = 2648
        .Style = msoButtonIcon
        .Caption = "Передача"
        .OnAction = "EXPORT"
    End With
    Sheets("Передача").Activate
    Application.StatusBar = "Для формирования файлов нажмите кнопку ""Передача"""
    ToolbarAction.Visible = True
    Application.Visible = True
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")

'Stop
Call writeHead_svod
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

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 = False '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 + IIf(lcCodeStr <> "", vbTab, "") + codeArr(i)
                    GoTo eee
                End If
            Next
        Else
            If linkArr(i) = VBA.Val(bar) Then lcCodeStr = lcCodeStr + IIf(lcCodeStr <> "", vbTab, "") + 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 + vbTab + num_To_Str(0, 15)
        Else
            lcCodeStr = lcCodeStr + vbTab + 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:
    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

' Формирование заключительной части
Call writeFooter_svod
'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
    
'hWnd = FindWindow("XLMAIN", 0)
'LockWindowUpdate (hWnd)

    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
    
    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 sum(i) <> VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i)) 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
        rowData = rowData + 1
    Wend
    
    ' Установка флага конца операции
    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)

    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
    
    lineCount = sheetsService.Range("A9") - sheetsService.Range("C5") + 1
    ReDim codeArr(lineCount)
    ReDim linkArr(lineCount)
    
    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
    
    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
    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

'добавляет итоговые строки (80000) для форм 614(714) в SQLDATA2
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
                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
                
                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)
                
                GoTo sss
            Else
sss:
                For i = 1 To IIf(Razdel = 1, 3, 1)
                    sum(i) = sum(i) + VBA.Val(sheetsSQLDATA2.Cells(rowData, 7 + i))
                Next
            End If
        rowData = rowData + 1
    Wend

End Sub

Sub after_output_f605()

End Sub

Sub writeHead_svod()
    Dim row As Integer, col As Integer
    Dim str As String, LookRange As Range, temp As Integer
    Dim lcDate_beg As String, lcDate_end As String, lcDate_tek As String
        
    lcDate_end = VBA.Trim(Sheets("Service").Range("A19"))
    lcDate_end = DateAdd("d", 1, VBA.Mid(lcDate_end, 7, 2) + "." + VBA.Mid(lcDate_end, 5, 2) + "." + VBA.Mid(lcDate_end, 1, 4))
    lcDate_end = VBA.Format(lcDate_end, "dd.mm.yyyy")
    lcDate_beg = VBA.Trim(Sheets("Service").Range("A18"))
    lcDate_beg = VBA.Mid(lcDate_beg, 7, 2) + "." + VBA.Mid(lcDate_beg, 5, 2) + "." + VBA.Mid(lcDate_beg, 1, 4)
    lcDate_beg = VBA.Format(lcDate_beg, "dd.mm.yyyy")
    lcDate_tek = VBA.Format(Date, "dd.mm.yyyy")
    
    If exists_name("HEAD_IN_OUT") Then
        row = Sheets("Service").Range("HEAD_IN_OUT").row
        col = Sheets("Service").Range("HEAD_IN_OUT").Column
        While Sheets("Service").Cells(row, col) <> ""
            str = Sheets("Service").Cells(row, col).Text
            If VBA.InStr(1, str, "%TERR") <> 0 Then str = Replace_in_Str(str, "%TERR", IIf(VBA.Len(VBA.Trim(Sheets("Service").Range("C11").Text)) = 1, "0" + VBA.Trim(Sheets("Service").Range("C11").Text), VBA.Trim(Sheets("Service").Range("C11").Text))) + VBA.Trim(Sheets("Service").Range("B3").Text)
            If VBA.InStr(1, str, "%DEP") <> 0 Then str = Replace_in_Str(str, "%DEP", VBA.Trim(Sheets("SQLDATA2").Cells(1, 3).Text))
            If VBA.InStr(1, str, "%DIV") <> 0 Then str = Replace_in_Str(str, "%DIV", VBA.Trim(Sheets("SQLDATA2").Cells(1, 4).Text))
            If VBA.InStr(1, str, "%TGT") <> 0 Then str = Replace_in_Str(str, "%TGT", VBA.Trim(Sheets("SQLDATA2").Cells(1, 5).Text))
            If VBA.InStr(1, str, "%EXP") <> 0 Then str = Replace_in_Str(str, "%EXP", VBA.Trim(Sheets("SQLDATA2").Cells(1, 6).Text))
            If VBA.InStr(1, str, "%DATE_TEK") <> 0 Then str = Replace_in_Str(str, "%DATE_TEK", lcDate_tek)
            If VBA.InStr(1, str, "%DATE_BEG") <> 0 Then str = Replace_in_Str(str, "%DATE_BEG", lcDate_beg)
            If VBA.InStr(1, str, "%DATE_END") <> 0 Then str = Replace_in_Str(str, "%DATE_END", lcDate_end)
            If VBA.InStr(1, str, "%STR_COUNT") <> 0 Then
                Set LookRange = Sheets("SQLDATA2").Columns(1).Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
                If Not LookRange Is Nothing Then
                    temp = LookRange.row - 1
                Else
                    temp = 0
                End If
                str = Replace_in_Str(str, "%STR_COUNT", VBA.Trim(VBA.str(temp)))
            End If
            If VBA.InStr(1, str, "%STRUCT") <> 0 Then
                With Sheets("Service")
                    'чистим критерий
                    .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) = .Range("B20")
                    .Cells(KRIT_RAZDEL_ROW + 7, KRIT_RAZDEL_COLUMN).CALCULATE
                    str = Replace_in_Str(str, "%STRUCT", VBA.Trim(.Cells(KRIT_RAZDEL_ROW + 7, KRIT_RAZDEL_COLUMN)))
                    .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = ""
                End With
            End If
            Print #1, str
            Sheets("SQLDATA2").Visible = -1
            row = row + 1
        Wend
    Else
        Print #1, "Заголовок файла шаблона не настроен !!!"
    End If
End Sub

Sub writeFooter_svod()
    Dim row As Integer, col As Integer, tempStr As String
    Dim str As String, LookRange As Range, temp As Integer
    Dim i As Integer
    
    If exists_name("FOOTER_IN_OUT") Then
        row = Sheets("Service").Range("FOOTER_IN_OUT").row
        col = Sheets("Service").Range("FOOTER_IN_OUT").Column
        While Sheets("Service").Cells(row, col) <> ""
            'проверим маску
            If (Sheets("Service").Cells(row, col + 2) And (2 ^ (Sheets("Service").Range("B20") - 1))) <> 0 Then
            
                str = Sheets("Service").Cells(row, col) + IIf(Sheets("Service").Cells(row, col + 1) <> "", vbTab + Sheets("Service").Cells(row, col + 1), "")
                
                If VBA.InStr(1, str, "%STR_COUNT") <> 0 Then
                     
                    i = Sheets("Service").Range("FOOTER_IN_OUT").row
                    temp = 0
                    While Sheets("Service").Cells(i, col) <> ""
                        If (Sheets("Service").Cells(i, col + 2) And (2 ^ (Sheets("Service").Range("B20") - 1))) <> 0 Then temp = temp + 1
                        i = i + 1
                    Wend
                    str = Replace_in_Str(str, "%STR_COUNT", VBA.Trim(VBA.str(IIf(temp - 2 < 0, 0, temp - 2))))
                End If
                If VBA.InStr(1, str, """ED_IZM""") <> 0 Then
                    Select Case Sheets("Service").Range("A28").Value
                        Case 1
                            str = str + vbTab + """руб"""
                        Case 2
                            str = str + vbTab + """тыс руб"""
                        Case 3
                            str = str + vbTab + """млн руб"""
                        Case 4
                            str = str + vbTab + """млрд руб"""
                    End Select
                End If
                If VBA.InStr(1, str, """GR""") <> 0 Then str = str + vbTab + """"""
                If VBA.InStr(1, str, """OKPO""") <> 0 Then str = str + vbTab + """"""
                If VBA.InStr(1, str, """PPP""") <> 0 Then str = str + vbTab + """" + VBA.Trim(Sheets("SQLDATA2").Cells(1, 3).Text) + """"
                If VBA.InStr(1, str, """RUK""") <> 0 Then str = str + vbTab + """"""
                If VBA.InStr(1, str, """GLB""") <> 0 Then str = str + vbTab + """"""
                
                Print #1, str
            End If
            row = row + 1
        Wend
    Else
        Print #1, "Заголовок файла шаблона не настроен !!!"
    End If
End Sub

Function readHead() As Integer
    Dim row As Integer, col As Integer, bool As Boolean, lSheetsReport As Worksheet
    Dim rStr As String, str As String, LookRange As Range, temp As Integer, i As Integer, j As Integer
    Dim lcDate_beg As String, lcDate_end As String, lcDate_tek As String
    Dim struct As String
'    lcDate_end = VBA.Trim(Sheets("Service").Range("A19"))
'    lcDate_end = DateAdd("d", 1, VBA.Mid(lcDate_end, 7, 2) + "." + VBA.Mid(lcDate_end, 5, 2) + "." + VBA.Mid(lcDate_end, 1, 4))
'    lcDate_end = VBA.Format(lcDate_end, "dd.mm.yyyy")
'    lcDate_beg = VBA.Trim(Sheets("Service").Range("A18"))
'    lcDate_beg = VBA.Mid(lcDate_beg, 7, 2) + "." + VBA.Mid(lcDate_beg, 5, 2) + "." + VBA.Mid(lcDate_beg, 1, 4)
'    lcDate_beg = VBA.Format(lcDate_beg, "dd.mm.yyyy")
'    lcDate_tek = VBA.Format(Date, "dd.mm.yyyy")

    
    If exists_name("HEAD_IN_OUT") Then
        
        'заголовок формы
        rStr = VBA.UCase(ReadLine(j))
        
        row = Sheets("Service").Range("HEAD_IN_OUT").row
        col = Sheets("Service").Range("HEAD_IN_OUT").Column
        'найдем соответствующий лист
        Sheets("Service").Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + 1) = ""
        For i = 1 To Sheets("Service").Range("B23")
            ' установим страницу
            ' зададим критерий
            Sheets("Service").Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = i
            If Sheets("Service").Range("B23") = 1 Then
                Set lSheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Range("B19").Text)
            Else
                Sheets("Service").Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN).CALCULATE
                Set lSheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Cells(KRIT_RAZDEL_ROW + 3, KRIT_RAZDEL_COLUMN).Text)
            End If
            lSheetsReport.Activate
            If Sheets("Service").Cells(row, col).Text = rStr Then GoTo ok1
        
        Next
        readHead = 1
        Print #2, "Неизвестный код формы """ + rStr + """ !"
        Exit Function
        
ok1:
        Sheets("Service").Cells(KRIT_RAZDEL_ROW + 7, KRIT_RAZDEL_COLUMN).CALCULATE
        struct = Sheets("Service").Cells(KRIT_RAZDEL_ROW + 7, KRIT_RAZDEL_COLUMN)
        borderCount = chr_count(struct, ",")
        row = row + 1
        While Sheets("Service").Cells(row, col) <> ""
            rStr = ReadLine(j)
            str = Sheets("Service").Cells(row, col).Text
            If VBA.InStr(1, str, "%TERR") <> 0 Then
                'правый символ не анализируем
                If Not Check_Corr(VBA.Left(rStr, VBA.Len(rStr) - 1), j) Then
                    readHead = j
                    Exit Function
                End If
            End If
            If VBA.InStr(1, str, "%DEP") <> 0 Then
                If VBA.Len(rStr) = 3 Then
                    Sheets("Service").Range("B28") = rStr
                Else
                    Print #2, "Неверный код ведомства """ + rStr + """, строка " + VBA.str(lineNum)
                End If
            End If
            If VBA.InStr(1, str, "%DIV") <> 0 Then
                If VBA.Len(rStr) = 4 Then
                    Sheets("Service").Range("B27") = rStr
                Else
                    Print #2, "Неверный код подраздела """ + rStr + """, строка " + VBA.str(lineNum)
                End If
            End If
            If VBA.InStr(1, str, "%TGT") <> 0 Then
                If VBA.Len(rStr) = 3 Then
                    Sheets("Service").Range("B29") = rStr
                Else
                    Print #2, "Неверный код целевой статьи """ + rStr + """, строка " + VBA.str(lineNum)
                End If
            End If
            If VBA.InStr(1, str, "%EXP") <> 0 Then
                If VBA.Len(rStr) = 5 Then
                    Sheets("Service").Range("B30") = rStr
                Else
                    Print #2, "Неверный код вида расхода """ + rStr + """, строка " + VBA.str(lineNum)
                End If
            End If
            If VBA.InStr(1, str, "%DATE_BEG") <> 0 Then
                If IsDate(rStr) Then
                    lcDate_beg = rStr
                Else
                    readHead = 8
                    Exit Function
                End If
                Sheets("Service").Range("A18") = Year(lcDate_beg) & IIf(Month(lcDate_beg) < 10, "0", "") & Month(lcDate_beg) & IIf(Day(lcDate_beg) < 10, "0", "") & Day(lcDate_beg)
            End If
            If VBA.InStr(1, str, "%DATE_END") <> 0 Then
                If IsDate(rStr) Then
                    lcDate_end = rStr
                Else
                    readHead = 8
                    Exit Function
                End If
                lcDate_end = VBA.DateAdd("Y", -1, lcDate_end)
                Sheets("Service").Range("A19") = Year(lcDate_end) & IIf(Month(lcDate_end) < 10, "0", "") & Month(lcDate_end) & IIf(Day(lcDate_end) < 10, "0", "") & Day(lcDate_end)
            End If
            If VBA.InStr(1, str, "%STR_COUNT") <> 0 Then dataLinesCount = VBA.Val(rStr)
            If VBA.InStr(1, str, "%STRUCT") <> 0 Then
                If Replace_in_Str(struct, " ", "") <> Replace_in_Str(rStr, " ", "") Then
                    Print #2, "Неверный формат структуры отчета """ + rStr + """"
                    readHead = 99
                    Exit Function
                End If
            End If
            'Print #1, Str
            'Sheets("SQLDATA2").Visible = -1
            row = row + 1
        Wend
    Else
        Print #2, "Заголовок файла шаблона не настроен !!!"
        readHead = 99
    End If
    readHead = 0
End Function

'заполнение листа "Передача" данными отчета
Sub FILL_IN_OUT_PAGE()
Dim kritRow As Integer, kritCol As Integer, kritColCount As Integer, i As Integer, j As Integer
Dim sheetsInOut As Worksheet, sheetsService As Worksheet, pageName As String, colType As Integer, colNumber As Integer
Dim tempStr As String, Shift As Integer
    Set sheetsInOut = Sheets("Передача")
    Set sheetsService = Sheets("Service")
'инициализация заголовка
    'Stop
    'kritRow = sheetsInOut.Range("HEAD_IN_OUT").row
    'kritCol = sheetsInOut.Range("HEAD_IN_OUT").Column
    'kritColCount = sheetsInOut.Range("HEAD_IN_OUT").Columns.count
    'sheetsService.Visible = -1
    'For i = 1 To kritColCount
    '
    'Next
        
    kritRow = sheetsInOut.Range("DATA_IN_OUT").row
    kritCol = sheetsInOut.Range("DATA_IN_OUT").Column
    kritColCount = sheetsInOut.Range("DATA_IN_OUT").Columns.count
    For i = 1 To kritColCount
        colType = sheetsInOut.Cells(kritRow + 1, i)
        If colType = 1 Then
            'из данных
            If VBA.InStr(1, sheetsInOut.Cells(kritRow + 2, i), "|") <> 0 Then
                tempStr = sheetsInOut.Cells(kritRow + 2, i)
                pageName = getNextSubstr(tempStr, "|")
                colNumber = VBA.Val(tempStr)
            Else
                pageName = sheetsService.Range("B19")
                colNumber = sheetsInOut.Cells(kritRow + 2, i)
            End If
        End If
        If colType = 2 Then
            'из данных
            pageName = sheetsService.Range("B19")
            colNumber = sheetsInOut.Cells(kritRow + 2, i)
        End If
        Shift = 0
        For j = sheetsService.Range("C5") To sheetsService.Range("A9")
            If colType = 1 Then
                If Sheets(pageName).Cells(j, 1) <> 0 Then
                    sheetsInOut.Cells(kritRow + 4 + j - sheetsService.Range("C5") - Shift, kritCol + i - 1) = Sheets(pageName).Cells(j, colNumber)
                Else
                    Shift = Shift + 1
                End If
            Else
                If colType = 2 Then
                    If Sheets(pageName).Cells(j, 1) <> 0 Then
                        sheetsInOut.Cells(kritRow + 4 + j - sheetsService.Range("C5") - Shift, kritCol + i - 1).FormulaLocal = sheetsInOut.Cells(kritRow + 2, kritCol + i - 1).FormulaLocal
                    Else
                        Shift = Shift + 1
                    End If
                End If
            End If
        Next
    Next
End Sub

'заполнение отчета данными листа "Передача"
Sub FILL_REP_FROM_IN_OUT_PAGE()
Dim kritRow As Integer, kritCol As Integer, kritColCount As Integer, i As Integer, j As Integer
Dim sheetsInOut As Worksheet, sheetsService As Worksheet, pageName As String, colType As Integer, colNumber As Integer
Dim tempStr As String, Shift As Integer, last As Integer
    Set sheetsInOut = Sheets("Передача")
    Set sheetsService = Sheets("Service")
    kritRow = sheetsInOut.Range("DATA_IN_OUT").row
    kritCol = sheetsInOut.Range("DATA_IN_OUT").Column
    kritColCount = sheetsInOut.Range("DATA_IN_OUT").Columns.count
Stop
    'On Error GoTo 0
    last = LastCell(sheetsInOut.Cells).row
    For i = last To kritRow + 4 Step -1
        Sheets(sheetsService.Range("B19").Text).Cells(sheetsService.Range("A9") - 1, 3).Activate
        Call Add_Str
        For j = 1 To kritColCount
            colType = sheetsInOut.Cells(kritRow + 1, j)
            If colType = 1 Then
                'из данных
                If VBA.InStr(1, sheetsInOut.Cells(kritRow + 2, i), "|") <> 0 Then
                    tempStr = sheetsInOut.Cells(kritRow + 2, j)
                    pageName = getNextSubstr(tempStr, "|")
                    colNumber = VBA.Val(tempStr)
                Else
                    pageName = sheetsService.Range("B19")
                    colNumber = sheetsInOut.Cells(kritRow + 2, j)
                End If
                Sheets(pageName).Cells(ActiveCell.row, colNumber) = sheetsInOut.Cells(i, kritCol + j - 1)
            End If
            
        Next
    Next
    
        Shift = 0
        For j = sheetsService.Range("C5") To sheetsService.Range("A9")
            If colType = 1 Then
                If Sheets(pageName).Cells(j, 1) <> 0 Then
                    sheetsInOut.Cells(kritRow + 4 + j - sheetsService.Range("C5") - Shift, kritCol + i - 1) = Sheets(pageName).Cells(j, colNumber)
                Else
                    Shift = Shift + 1
                End If
            Else
                If colType = 2 Then
                    If Sheets(pageName).Cells(j, 1) <> 0 Then
                        sheetsInOut.Cells(kritRow + 4 + j - sheetsService.Range("C5") - Shift, kritCol + i - 1).FormulaLocal = sheetsInOut.Cells(kritRow + 2, kritCol + i - 1).FormulaLocal
                    Else
                        Shift = Shift + 1
                    End If
                End If
            End If
        Next
    'Next
End Sub

Sub export()
Dim kritRow As Integer, kritCol As Integer, kritColCount As Integer, i As Integer, j As Integer
Dim sheetsInOut As Worksheet, sheetsService As Worksheet, pageName As String, colType As Integer, colNumber As Integer
Dim path As String, str As String
Dim last As Integer
    
    path = Sheets("Service").Range("A54")
    Open path + Sheets("Передача").Range("HEAD_IN_OUT_FILE_NAME").Text For Output As #1
    
    Set sheetsInOut = Sheets("Передача")
    Set sheetsService = Sheets("Service")
    kritRow = sheetsInOut.Range("HEAD_IN_OUT").row
    kritCol = sheetsInOut.Range("HEAD_IN_OUT").Column
    kritColCount = sheetsInOut.Range("HEAD_IN_OUT").Columns.count
    
    For i = kritRow + 3 To kritRow + 4
        str = ""
        For j = kritCol To kritCol + kritColCount - 1
            str = str + IIf(j = kritCol, "", vbTab) + sheetsInOut.Cells(i, j).Text
        Next
        Print #1, convert_dos_win(str, 1)
    Next
    Close #1
    
    Open path + Sheets("Передача").Range("DATA_IN_OUT_FILE_NAME").Text For Output As #1
    
    Set sheetsInOut = Sheets("Передача")
    Set sheetsService = Sheets("Service")
    kritRow = sheetsInOut.Range("DATA_IN_OUT").row
    kritCol = sheetsInOut.Range("DATA_IN_OUT").Column
    kritColCount = sheetsInOut.Range("DATA_IN_OUT").Columns.count
    
    last = LastCell(sheetsInOut.Cells).row
    For i = kritRow + 3 To last
        str = ""
        For j = kritCol To kritCol + kritColCount - 1
            str = str + IIf(j = kritCol, "", vbTab) + sheetsInOut.Cells(i, j).Text
        Next
        Print #1, convert_dos_win(str, 1)
    Next
    Close #1
    
    Call MsgBox("Файлы """ + path + Sheets("Передача").Range("HEAD_IN_OUT_FILE_NAME").Text + """ и """ + path + Sheets("Передача").Range("DATA_IN_OUT_FILE_NAME").Text + """ успешно созданы!", vbInformation, "Формирование файлов")
End Sub
