Attribute VB_Name = "order72n"
Option Explicit

Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_DECIMAL = &HE
#If Win64 Then
    Public Declare PtrSafe Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
    Public Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
    Private Declare PtrSafe Function GetEnvironmentStrings Lib "kernel32" Alias "GetEnvironmentStringsA" () As Long
    Private Declare PtrSafe Function FreeEnvironmentStrings Lib "kernel32" Alias "FreeEnvironmentStringsA" (ByVal lpsz As String) As Long
    Private Declare PtrSafe Function LStrLen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
#Else
    Public Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
    Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
    Private Declare Function GetEnvironmentStrings Lib "kernel32" Alias "GetEnvironmentStringsA" () As Long
    Private Declare Function FreeEnvironmentStrings Lib "kernel32" Alias "FreeEnvironmentStringsA" (ByVal lpsz As String) As Long
    Private Declare Function LStrLen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
#End If
'---------------------------------------------------------------------------------------------------------------
' Функция проверки существования имени в листе
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function ExistsNamesSheet(ByVal ws As Worksheet, ByVal sName As String) As Boolean
Dim i As Integer
    If sName <> "" Then
        For i = 1 To ws.Names.count
            If VBA.Mid(ws.Names(i).name, VBA.InStr(ws.Names(i).name, "!") + 1) = sName Then
                ExistsNamesSheet = True
                Exit Function
            End If
        Next
    End If
    ExistsNamesSheet = False
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция определения рабочего окружения
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function GetEnvironment(ByVal cEnvName As String) As String
Dim nRef As Long
Dim cItem, cRes As String
Dim nLen As Long
    cRes = ""
    cEnvName = VBA.Trim(cEnvName)
    If cEnvName = "" Then
        GetEnvironment = cRes
        Exit Function
    End If
    nRef = GetEnvironmentStrings()
    Do
        nLen = LStrLen(nRef)
        If nLen = 0 Then Exit Do
        cItem = VBA.Space$(nLen)
        CopyMemory ByVal cItem, ByVal nRef, nLen
        cItem = VBA.Trim(cItem)
        If VBA.InStr(cItem, cEnvName + "=") = 1 Then
            cRes = VBA.Replace(cItem, cEnvName + "=", "")
            Exit Do
        End If
        nRef = nRef + LStrLen(nRef) + 1
    Loop
    FreeEnvironmentStrings nRef
    GetEnvironment = cRes
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция формирования имени файла
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function GetFileName(ByVal nMode As Long, ByVal oSheet As Worksheet, Optional ByVal bVerSave As Boolean = False, Optional ByVal nMode1 As Long) As String
Dim cFileName, cFormCode, cVersion, cDateReg, cSource, cSubject As String
    If nMode < 0 Or nMode > 1 Or ScriptGet(oSheet, "OUT_FORM_CODE") = "" Then
        GetFileName = ""
        Exit Function
    End If
    cFileName = ""
    cFormCode = ScriptGet(oSheet, "OUT_FORM_CODE")
    If nMode1 = 5 Then 'Выгрузка в формате ДФ г. Москва
        cFormCode = "164"
    End If
    cSource = "4"
    cSubject = ScriptGet(oSheet, "SUBJECT_CODE")
    cDateReg = VBA.Left(VBA.Replace(ScriptGet(oSheet, "dDate_2"), ".", ""), 4)
    cVersion = ScriptGet(oSheet, "OUT_NUMBER_VERSION")
    cVersion = VBA.Trim(VBA.Str(VBA.Val(cVersion) + VBA.IIf(nMode = 0, 1, 0)))
    If bVerSave Then
        Call ScriptSet(oSheet, "OUT_NUMBER_VERSION", cVersion)
    End If
    ' формирование имени файла (формат МФ)
    If nMode = 0 Then
        Select Case cFormCode
        Case "164" and nMode1 <> 5
            cFileName = cFormCode + IIf(nMode1 = 3, "M", IIf(nMode1 = 2, "Y", "M")) + cVersion + ".TXT"
        Case "464"
            cFileName = cFormCode + IIf(nMode1 = 3, "M", IIf(nMode1 = 2, "Y", "M")) + cVersion + ".TXT"
        Case "125"
            cFileName = cFormCode + "Y" + cVersion + ".TXT"
        Case "425"
            cFileName = cFormCode + "Y" + cVersion + ".TXT"
        Case "280"
            cFileName = cFormCode + "Y" + cVersion + ".TXT"
        Case "482"
            cFileName = cFormCode + "Y" + cVersion + ".TXT"
        Case "164" and nMode1 = 5 'формат ДФ г. Москва
           cFileName = cFormCode + VBA.Left(VBA.Right(ScriptGet(oSheet, "dDate_2"), 7), 2) + VBA.Right(ScriptGet(oSheet, "dDate_2"), 2) + "g" + cVersion + ".TXT"
        Case "424" 'форма 0503324
           cFileName = cFormCode + IIf(VBA.Left(ScriptGet(oSheet, "dDate"), 5) = "31.12", "Y", "M") + cVersion + ".TXT"
         End Select
    End If
    ' формирование имени архива (формат МФ)
    If nMode = 1 Then
       If VBA.Len(cSubject) < 3 Then
             cSubject = VBA.String(3 - VBA.Len(cSubject), "0") + cSubject
       End If
        Select Case cFormCode
        Case "164" and nMode1 <> 5
            cFileName = cSource + cSubject + cDateReg + cVersion + ".ARJ"
        Case "464"
            cFileName = cSource + cSubject + cDateReg + cVersion + ".ARJ"
        Case "125"
            cFileName = cSource + cSubject + cDateReg + cVersion + ".ARJ"
        Case "425"
            cFileName = cSource + cSubject + cDateReg + cVersion + ".ARJ"
        Case "280"
            cFileName = cSource + cSubject + cDateReg + cVersion + ".ARJ"
        Case "482"
            cFileName = cSource + cSubject + cDateReg + cVersion + ".ARJ"
        Case "164" and nMode1 = 5'формат ДФ г. Москва
           cFileName = "0" + cSubject + cVersion + ".ARJ"
        Case "424" 'форма 0503324
           cFileName = cFormCode + IIf(VBA.Left(ScriptGet(oSheet, "dDate"), 5) = "31.12", "Y", "M") + cVersion + ".ARJ"
        End Select
    End If
    GetFileName = cFileName
End Function
'---------------------------------------------------------------------------------------------------------------
' GetLocalInfo
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function GetLocalInfo(ByVal nInfo As Long) As String
Dim cBuffer, nRet As String
    cBuffer = VBA.String$(256, 0)
    nRet = GetLocaleInfo(LOCALE_USER_DEFAULT, nInfo, cBuffer, VBA.Len(cBuffer))
    GetLocalInfo = VBA.Trim(VBA.IIf(nRet > 0, VBA.Left$(cBuffer, nRet - 1), ""))
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция определит ПРД(период)
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function GetPRD(ByVal cDatePRD As String) As String
Dim cResult As String
Dim dDateEnd As Date
    cResult = ""
    If VBA.IsDate(cDatePRD) Then
        dDateEnd = VBA.CDate(cDatePRD)
        Select Case dDateEnd
        Case VBA.CDate("31.12." & VBA.Year(dDateEnd))
            cResult = "5"
        Case VBA.CDate("31.03." & VBA.Year(dDateEnd)), VBA.CDate("30.06." & VBA.Year(dDateEnd)), VBA.CDate("30.09." & VBA.Year(dDateEnd))
            cResult = "4"
        Case Else
            cResult = "3"
        End Select
    End If
    GetPRD = cResult
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция определит короткий путь
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function GetShortPath(ByVal cFileName As String) As String
Dim nRes As Long
Dim cPath As String
    cPath = VBA.String$(255, 0)
    nRes = GetShortPathName(cFileName, cPath, 254)
    GetShortPath = VBA.Left$(cPath, nRes)
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция GetStrParam
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function GetStrParam(ByVal cParam As String, ByVal nParam As Integer, Optional ByVal cPart As String = "#") As String
Dim nPos1, nPos2 As Integer
Dim i As Long
    nPos1 = 0
    i = 1
    While i < nParam
        nPos1 = VBA.InStr(nPos1 + 1, cParam, cPart)
        If nPos1 = 0 Then
            GetStrParam = ""
            Exit Function
        End If
        i = i + 1
    Wend
    nPos2 = VBA.InStr(nPos1 + 1, cParam, cPart)
    nPos2 = VBA.IIf(nPos2 = 0, VBA.Len(cParam), nPos2 - 1)
    If nPos2 > nPos1 Then
        GetStrParam = VBA.Mid(cParam, nPos1 + 1, nPos2 - nPos1)
    Else
        GetStrParam = ""
    End If
End Function
'---------------------------------------------------------------------------------------------------------------
' Иницилизация установок
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub InitSettings(ByVal cMode As String)
Dim oBook As Workbook
Dim oSheet As Worksheet
Dim oRange1, oRange2, oFind, oRange As Range
    Application.Calculation = xlManual
    Set oBook = Application.ActiveWorkbook
    ' SECTIONS_INIT
    For Each oSheet In oBook.Worksheets
        If oSheet.Visible = -1 Then
            Set oFind = oSheet.Rows(1)
            Set oRange = oFind.Find(What:="SECTIONS_INIT", LookIn:=xlValues, LookAt:=xlWhole)
            If Not oRange Is Nothing Then
                oRange.Clear
                Set oFind = oSheet.Columns(oRange.column)
                Set oRange1 = oFind.Find(What:="SECTIONS_BEGIN", LookIn:=xlValues, LookAt:=xlWhole)
                Set oRange2 = oFind.Find(What:="SECTIONS_END", LookIn:=xlValues, LookAt:=xlWhole)
                If Not oRange1 Is Nothing And Not oRange2 Is Nothing Then
                    oRange1.Clear
                    oRange2.Clear
                    If oRange2.Row - oRange1.Row > 2 Then
                        Call InsertNamesSheet(oSheet, "DATA_SECTION", _
                            oSheet.Cells(oRange1.Row + 1, 1).Address + ":" + oSheet.Cells(oRange2.Row - 1, oRange2.column - 1).Address)
                    End If
                End If
            End If
        End If
    Next oSheet
    Application.Calculation = xlCalculationAutomatic
End Sub
'---------------------------------------------------------------------------------------------------------------
' Иницилизация меню для ф.0503324
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub InitToolbar_For_72n324(ByVal cMode As String)
Dim bFound As Boolean
Dim oToolbar, oControl As Object
    bFound = False
    For Each oToolbar In Application.CommandBars
        If oToolbar.name = "Order72n" Then bFound = True
    Next
    If bFound Then Application.CommandBars("Order72n").Delete

    Set oToolbar = CommandBars.Add(name:="Order72n", Position:=msoBarTop, Temporary:=True)

    With oToolbar.Controls.Add(Type:=msoControlPopup)
        .Caption = "Выгрузить данные"
        
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате МФ РФ"
        oControl.OnAction = "UnloadMF_324"
    
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате ""Бюджет-КС"""
        oControl.OnAction = "UnloadBKS_324"
    End With
    
    oToolbar.Enabled = True
    oToolbar.Visible = True
    Application.ActiveWorkbook.Saved = True
    Application.ThisWorkbook.Saved = True
End Sub
'---------------------------------------------------------------------------------------------------------------
' Иницилизация меню для ф.0503164
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub InitToolbar_For_72n164(ByVal cMode As String)
Dim bFound As Boolean
Dim oToolbar, oControl As Object
    bFound = False
    For Each oToolbar In Application.CommandBars
        If oToolbar.name = "Order72n" Then bFound = True
    Next
    If bFound Then Application.CommandBars("Order72n").Delete

    Set oToolbar = CommandBars.Add(name:="Order72n", Position:=msoBarTop, Temporary:=True)

    With oToolbar.Controls.Add(Type:=msoControlPopup)
        .Caption = "Выгрузить данные"
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "По форматам месячного отчета"
        oControl.OnAction = "UnloadFormatMFRepMonth"

        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "По форматам годового отчета"
        oControl.OnAction = "UnloadFormatMF"
    
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате ""Бюджет-КС"""
        oControl.OnAction = "UnloadFormatBKS"

        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате ДФ г. Москва"
        oControl.OnAction = "UnloadFormatDF"
    End With
    
    oToolbar.Enabled = True
    oToolbar.Visible = True
    Application.ActiveWorkbook.Saved = True
    Application.ThisWorkbook.Saved = True
End Sub
'---------------------------------------------------------------------------------------------------------------
' Иницилизация меню для ф.0503125
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub InitToolbar_0503125(ByVal cMode As String)
Dim bFound As Boolean
Dim oToolbar, oControl As Object
    bFound = False
    For Each oToolbar In Application.CommandBars
        If oToolbar.name = "Order72n" Then bFound = True
    Next
    If bFound Then Application.CommandBars("Order72n").Delete

    Set oToolbar = CommandBars.Add(name:="Order72n", Position:=msoBarTop, Temporary:=True)

    With oToolbar.Controls.Add(Type:=msoControlPopup)
        .Caption = "Выгрузить данные"
        
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате МФ РФ"
        oControl.OnAction = "UnloadFormatMF"
    
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате ""Бюджет-КС"""
        oControl.OnAction = "UnloadFormatBKS"

        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате ""Свод-КС"""
        oControl.OnAction = "UnloadFormatSvod"
    End With
    oToolbar.Enabled = True
    oToolbar.Visible = True
    Application.ActiveWorkbook.Saved = True
    Application.ThisWorkbook.Saved = True
End Sub
'---------------------------------------------------------------------------------------------------------------
' Иницилизация меню
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub InitToolbar(ByVal cMode As String)
Dim bFound As Boolean
Dim oToolbar, oControl As Object
    bFound = False
    For Each oToolbar In Application.CommandBars
        If oToolbar.name = "Order72n" Then bFound = True
    Next
    If bFound Then Application.CommandBars("Order72n").Delete

    Set oToolbar = CommandBars.Add(name:="Order72n", Position:=msoBarTop, Temporary:=True)

    With oToolbar.Controls.Add(Type:=msoControlPopup)
        .Caption = "Выгрузить данные"
        
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате МФ РФ"
        oControl.OnAction = "UnloadFormatMF"
    
        Set oControl = .Controls.Add(Type:=msoControlButton)
        oControl.Style = msoButtonIcon
        oControl.Caption = "В формате ""Бюджет-КС"""
        oControl.OnAction = "UnloadFormatBKS"
    End With
    oToolbar.Enabled = True
    oToolbar.Visible = True
    Application.ActiveWorkbook.Saved = True
    Application.ThisWorkbook.Saved = True
End Sub
'---------------------------------------------------------------------------------------------------------------
' InsertNamesSheet
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub InsertNamesSheet(ByVal oSheet As Worksheet, ByVal cName As String, ByVal cAddress As String)
    If Not ExistsNamesSheet(oSheet, cName) Then
        If VBA.InStr(oSheet.name, " ") > 0 Then
            oSheet.Names.Add name:=cName, RefersToLocal:="='" & oSheet.name & "'!" & cAddress
        Else
            oSheet.Names.Add name:=cName, RefersToLocal:="=" & oSheet.name & "!" & cAddress
        End If
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' Вывод в файл
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub PrintFile(ByVal lcFile As String, ByVal lnMode As Integer, ByVal lcStr As String)
    If lcFile = "" Then Exit Sub
    If lnMode = 0 Then
        Open lcFile For Output As #1
    Else
        Open lcFile For Append As #1
    End If
    Print #1, lcStr
    Close #1
End Sub
'---------------------------------------------------------------------------------------------------------------
' Функция замены в строке
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function ReplaceStr(ByVal lcTemplate As String, ByVal strWhat As String, ByVal strOnWhat As String) As String
    Dim lnStartBegin As Integer, lnStartEnd As Integer, lnLenWhat As Integer
    Dim lcExprLeft As String, lcExprRight As String
    Dim TEMPLATE As String
    
    TEMPLATE = lcTemplate
    While VBA.InStr(1, TEMPLATE, strWhat, vbTextCompare) <> 0
        lnLenWhat = VBA.Len(strWhat)
        lnStartBegin = VBA.InStr(1, TEMPLATE, strWhat, vbTextCompare)
        lnStartEnd = lnStartBegin + lnLenWhat
        lcExprLeft = VBA.Left(TEMPLATE, lnStartBegin - 1)
        lcExprRight = VBA.Right(TEMPLATE, VBA.Len(TEMPLATE) - lnStartEnd + 1)
        TEMPLATE = lcExprLeft + strOnWhat + lcExprRight
    Wend
    
    ReplaceStr = TEMPLATE
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция проверки существования Scripts
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function ScriptExists(ByVal oSheet As Worksheet, ByVal cIDScript As String) As Boolean
Dim bRes As Boolean
Dim n As Long
    bRes = False
    cIDScript = VBA.Trim(cIDScript)
    
    For n = 1 To oSheet.Scripts.count
        If VBA.UCase(VBA.Trim(oSheet.Scripts(n).ID)) = VBA.UCase(VBA.Trim(cIDScript)) Then
            bRes = True
        End If
    Next n
    ScriptExists = bRes
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция получения данных из Scripts
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Function ScriptGet(ByVal oSheet As Worksheet, ByVal cIDScript As String) As String
Dim cRes As String
    cRes = ""
    cIDScript = VBA.Trim(cIDScript)
    If ScriptExists(oSheet, cIDScript) Then
        cRes = VBA.Trim(oSheet.Scripts(cIDScript).ScriptText)
    End If
    ScriptGet = cRes
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция записи данных в Scripts
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub ScriptSet(ByVal oSheet As Worksheet, ByVal cIDScript As String, ByVal cValueScript As String)
    cIDScript = VBA.Trim(cIDScript)
    cValueScript = VBA.Trim(cValueScript)
    If Not ScriptExists(oSheet, cIDScript) Then
        oSheet.Scripts.Add Location:=2, Language:=2, ID:=cIDScript, ScriptText:=cValueScript
    Else
        oSheet.Scripts(cIDScript).ScriptText = cValueScript
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка данных
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadData(ByVal nMode As Long)
Dim cDecimal, cSavePath, cFullPath, cSaveFile, cFormCode, cRdList, cColList, cColSort, cKeyCol, cKeyList, cSep, cSepMode, cDataRow As String
Dim cFooter, cArjFile, cEnvPath, cArjExe, cCmd, cReplaceList, cReplaceValue, cCol, cDataRowT, cTmp1, cTmp2, cTmp3, cTmp4, cTmp5 As String
Dim oCurrSheet, oWorkSheet As Worksheet
Dim oCurrBook As Workbook
Dim oData As Range
Dim nTop, nLeft, nHeight, nWidth, nCol, nShift, nRow, nIndex, nRd, nKeyCol, nAnswer, RetVal, nReplace, nFlag14 As Long
Dim aColSort() As String, aRdList() As String, aColList() As String, aKeyList() As String, aCol() As String, aEnvPath() As String, aReplaceList() As String, aReplaceValue() As String
Dim bSepFirst, bSepLast, bArjExe As Boolean
Dim oFolder As Variant
Dim WshShell As Object
    
    On Error GoTo ErrMain
    cDecimal = GetLocalInfo(LOCALE_DECIMAL)
    Set oCurrBook = Application.ActiveWorkbook
    Set oCurrSheet = Application.ActiveSheet
    ' Если не задан код формы - выгрузки нет
    If ScriptGet(oCurrSheet, "OUT_FORM_CODE") = "" Or Not ExistsNamesSheet(oCurrSheet, "DATA_SECTION") Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена." + VBA.vbNewLine + "Неизвестная отчетная форма.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        Exit Sub
    End If
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    oCurrSheet.Select
    oCurrSheet.Copy After:=oCurrBook.Sheets(oCurrBook.Sheets.count)
    Set oWorkSheet = Application.ActiveSheet
    ' Имя файла для выгрузки
    cSaveFile = GetFileName(0, oCurrSheet, False, nMode)
    oFolder = Application.GetSaveAsFilename(InitialFileName:=cSaveFile, FileFilter:="Текстовый файл,*.txt", Title:="Выгрузка данных страницы в файл формата " + VBA.IIf(nMode = 1, "БЮДЖЕТ-КС", "МФ РФ"))
    If oFolder = False Then
        GoTo Quit
    End If
    
    nIndex = 0
    Do While VBA.InStr(nIndex + 1, oFolder, "\") > 0
        nIndex = VBA.InStr(nIndex + 1, oFolder, "\")
    Loop
    
    If nIndex = 0 Then
        Call VBA.MsgBox("Выгрузка не выполнена. Некорректно указан путь для выгрузки.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo Quit
    End If
    
    cSavePath = VBA.Left(oFolder, nIndex)
    cFullPath = cSavePath
    cSavePath = GetShortPath(cSavePath)
    If VBA.Dir(cSavePath, VBA.vbDirectory) = "" Then Call VBA.MkDir(cSavePath)
    oFolder = VBA.Trim(VBA.Mid(oFolder, nIndex + 1))
    If oFolder = cSaveFile Or oFolder = "" Then
        cSaveFile = GetFileName(0, oCurrSheet, True, nMode)
    Else
        cSaveFile = oFolder
    End If
    
    Set oData = oWorkSheet.Range("DATA_SECTION")
    nTop = oData.Cells(1, 1).Row
    nLeft = oData.Cells(1, 1).column
    nHeight = oData.Rows.count
    nWidth = oData.Columns.count
    
    ' настройки
    cFormCode = ScriptGet(oWorkSheet, "OUT_FORM_CODE")
    If nMode = 5 Then 'Формат ДФ г. Москва
        cFormCode = "164"
    End If
    nFlag14 = VBA.Val(ScriptGet(oWorkSheet, "nCheck_14")) 'EdiS Флаг 164-ой формы если опция n_Check_14 не включена - 0, иначе = 1
    cRdList = ScriptGet(oWorkSheet, "OUT_RAZDEL_LIST")
    If (nMode = 4 And (cFormCode = "125" Or cFormCode = "425")) Then ' в Свод-КС кол. разделов
        cRdList = "01#02#03"
    End If
    aRdList = VBA.Split(cRdList, "#")
    
    cColList = ScriptGet(oWorkSheet, "OUT_COLUMN_LIST")
    If (nMode = 4 And (cFormCode = "125" Or cFormCode = "425")) Then ' в Свод-КС порядок граф при выгрузке по разделам
        cColList = IIf(cFormCode = "125", "1,6,7,2,3,4,5,8#1,6,7,2,3,4,5,8#1,6,7,2,3,4,5,8", "1,2,3,4,5,6,7,8#1,2,3,4,5,6,7,8#1,2,3,4,5,6,7,8")
    End If
    cColSort = ScriptGet(oWorkSheet, "OUT_COLUMN_SORT")
    aColList = VBA.Split(cColList, "#")
    aColSort = VBA.Split(cColSort, ",")
    
    cSep = ScriptGet(oWorkSheet, "OUT_SEPARATOR")
    cSepMode = ScriptGet(oWorkSheet, "OUT_SEPARATOR_MODE")
    bSepFirst = (VBA.Val(cSepMode) And 1) > 0
    bSepLast = (VBA.Val(cSepMode) And 2) > 0
    
    cKeyCol = ScriptGet(oWorkSheet, "OUT_KEY_COLUMN")
    nKeyCol = VBA.Val(cKeyCol)
    cKeyList = ScriptGet(oWorkSheet, "OUT_KEY_LIST")
    If (nMode = 4 And (cFormCode = "125" Or cFormCode = "425")) Then ' в Свод-КС 9-ая колонка должна быть для итоговых 1-ый раздел - 7, 2-ой раздел -8, 3-ий раздел - 9
        cKeyList = "7#8#9"
    End If
    aKeyList = VBA.Split(cKeyList, "#")
    cReplaceList = ScriptGet(oWorkSheet, "OUT_REPLACE_LIST")
    If nMode = 5 And cFormCode = "164" Then
        cReplaceList = "1;1. Доходы, всего;00085000000000000000#1;2. Расходы, всего;00096000000000000000#1;Источники внутреннего финансирования дефицита бюджета;00090000000000000000#" + "1;3. Источники финансирования дефицитов бюджетов, всего;00090000000000000000#1;Источники внешнего финансирования дефицита бюджета;00090000000000000000#1;Результат исполнения бюджета(дефицит/профицит);00079000000000000000"
    End If
    aReplaceList = VBA.Split(cReplaceList, "#")
    ' проверки
    If Not VBA.IsArray(aRdList) Or Not VBA.IsArray(aColList) Or Not VBA.IsArray(aKeyList) Or nKeyCol <= 0 Or nKeyCol > nWidth Or cSep = "" Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена." + VBA.vbNewLine + "Обнаружены некорректные описания секций содержательной части отчетной формы.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo Quit
    End If
    If UBound(aRdList) <> UBound(aColList) Or UBound(aRdList) <> UBound(aKeyList) Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена." + VBA.vbNewLine + "Обнаружены некорректные описания секций содержательной части отчетной формы.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo Quit
    End If
    IF (cFormCode="125" Or cFormCode="425") Then
    Else
	    ' сортировка
	    If VBA.Val(Application.Version) >= 12 Then ' 2007
        	Call UnloadDataSort2007(oWorkSheet, oData, aColSort)
	    Else ' 2003 и ниже
	        Call UnloadDataSort2003(oWorkSheet, oData, aColSort)
	    End If
    End If	
    ' Заголовочная часть
    If nMode = 1 Then
        Call PrintFile(cSavePath + cSaveFile, 0, ScriptGet(oWorkSheet, "SUBJECT_NAME"))
        Call PrintFile(cSavePath + cSaveFile, 1, "ИСТ=" + ScriptGet(oWorkSheet, "SUBJECT_CODE"))
        Call PrintFile(cSavePath + cSaveFile, 1, "ДТ=" + VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, IIf(cFormCode = "424", "dDate", "dDate_2"))) + 1))
    Else
        If nMode = 4 Then
                Call PrintFile(cSavePath + cSaveFile, 0, ScriptGet(oWorkSheet, "ORG_CBP") + " " + ScriptGet(oWorkSheet, "SUBJECT_NAME"))
                Call PrintFile(cSavePath + cSaveFile, 1, "ВФ=0")
                Call PrintFile(cSavePath + cSaveFile, 1, "ПО=" + ScriptGet(oWorkSheet, "APPLICATION_INFO"))
                Call PrintFile(cSavePath + cSaveFile, 1, "КБП=" + ScriptGet(oWorkSheet, "ORG_CBP"))
                Call PrintFile(cSavePath + cSaveFile, 1, "ВБ=") 'вид бюджета в Свод-КС свой
                Call PrintFile(cSavePath + cSaveFile, 1, "КФ=" + IIf(cFormCode = "125", "0503125", "425") + IIf(GetPRD(VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate_2")))) = "5", "G", "M")) ' Если годовая - 0503125G, месяц 0503125M
                Call PrintFile(cSavePath + cSaveFile, 1, "ПРД=" + IIf(GetPRD(VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate_2")))) = "5", "1", "4")) 'В МФ(для Саод-КС) 5 - год(1), 3-месяц(4), 4-квартл(4)
                Call PrintFile(cSavePath + cSaveFile, 1, "ДФ=01.12.2009") 'дата формы
                Call PrintFile(cSavePath + cSaveFile, 1, "ДТ=" + VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate_2")) + 1)) 'расчетная дата
                Call PrintFile(cSavePath + cSaveFile, 1, "РА=0")
                Call PrintFile(cSavePath + cSaveFile, 1, "REPORTS_ATR_ACC=" + VBA.Left(oCurrSheet.Range("H12"), 9)) 'КСБУ
                Call PrintFile(cSavePath + cSaveFile, 1, "REPORTS_ATR_PRP=500") 'ПРП
        Else
                If nMode = 5 Then 'Формат ДФ г.Москва
                        Call PrintFile(cSavePath + cSaveFile, 1, "ИНН=" + VBA.Left(oCurrSheet.Range("F2"), 13)) 'ИНН
                        Call PrintFile(cSavePath + cSaveFile, 1, "ДАТА=" + VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate_2")) + 1))
                        Call PrintFile(cSavePath + cSaveFile, 1, "КОДФ=" + cFormCode)
                Else
                        Call PrintFile(cSavePath + cSaveFile, 0, "#%")
                        Call PrintFile(cSavePath + cSaveFile, 1, "КОДФ=" + cFormCode)
                        Call PrintFile(cSavePath + cSaveFile, 1, "ПРД=" + GetPRD(VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, IIf(cFormCode = "424", "dDate", "dDate_2"))))))
                        Call PrintFile(cSavePath + cSaveFile, 1, "РДТ=" + VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, IIf(cFormCode = "424", "dDate", "dDate_2"))) + 1))
                        Call PrintFile(cSavePath + cSaveFile, 1, "ВИД=" + IIf(cFormCode = "125" Or cFormCode = "280" Or cFormCode = "482", "3", ScriptGet(oWorkSheet, "OBJECT_SOURCE_TYPE")))
                        Call PrintFile(cSavePath + cSaveFile, 1, "ИСТ=" + ScriptGet(oWorkSheet, "SUBJECT_CODE"))
                        If (cFormCode = "125" Or cFormCode = "425") Then
                                Call PrintFile(cSavePath + cSaveFile, 1, "КСБУ=" + VBA.Left(oCurrSheet.Range("H12"), 9))
                        End If
                        Call PrintFile(cSavePath + cSaveFile, 1, "#")
                End If
        End If
    End If
    ' Содержательная часть
    For nRd = 0 To UBound(aRdList)
        If nMode = 1 Or nMode = 4 Or nMode = 5 Then
            Call PrintFile(cSavePath + cSaveFile, 1, "РД=" + VBA.Trim(VBA.Str(VBA.Val(aRdList(nRd)))))
        Else
            Call PrintFile(cSavePath + cSaveFile, 1, "#@")
            Call PrintFile(cSavePath + cSaveFile, 1, "ТБ=" + aRdList(nRd))
            Call PrintFile(cSavePath + cSaveFile, 1, "#$")
        End If
        For nRow = 1 To nHeight
            Application.StatusBar = "Формирование файла выгрузки. Выполнено: " + VBA.Format((nRd * nHeight + nRow) / ((UBound(aRdList) + 1) * nHeight), "0%")
            cDataRow = ""
            If VBA.InStr("," + aKeyList(nRd) + ",", "," + VBA.CStr(oData.Cells(nRow, nKeyCol).Value) + ",") > 0 Then
                aCol = VBA.Split(aColList(nRd), ",")
                For nCol = 0 To UBound(aCol)
                    If VBA.Val(aCol(nCol)) >= 1 And VBA.Val(aCol(nCol)) <= nWidth Then
                        cReplaceValue = VBA.CStr(oData.Cells(nRow, VBA.Val(aCol(nCol))).Value)

                        cCol = VBA.Trim(aCol(nCol))
                        For nReplace = 0 To UBound(aReplaceList)
                            If VBA.Left(VBA.Trim(aReplaceList(nReplace)), VBA.Len(cCol) + 1) = (cCol + ";") Then
                                aReplaceValue = VBA.Split(aReplaceList(nReplace), ";")
                                If UBound(aReplaceValue) = 2 Then
                                    If VBA.Trim(VBA.LCase(cReplaceValue)) = VBA.Trim(VBA.LCase(aReplaceValue(1))) Then
                                        cReplaceValue = VBA.Trim(aReplaceValue(2))
                                        Exit For
                                    End If
                                End If
                            End If
                        Next nReplace
                        If cFormCode = "424" Then '0503324
                                If VBA.Val(aCol(nCol)) = 2 And aRdList(nRd) = 1 Then 'Код главы по БК (3)
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) = 3, cReplaceValue, VBA.Right(cReplaceValue + "000", 3))
                                End If
                                If VBA.Val(aCol(nCol)) = 3 And aRdList(nRd) = 1 Then 'Код целевой статьи расходов по БК(7)
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) = 7, cReplaceValue, VBA.Right(cReplaceValue + "0000000", 7))
                                End If
                                If VBA.Val(aCol(nCol)) = 4 And aRdList(nRd) = 1 Then 'Код доходов по БК = АП(3)|КД(17)
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) = 20, VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 17), VBA.Right(cReplaceValue + "000|00000000000000000", 21))
                                End If
                                If VBA.Val(aCol(nCol)) = 2 And aRdList(nRd) = 2 Then 'Код главы по БК (3)
                                  cReplaceValue = IIf(VBA.Trim(cReplaceValue) = "x" Or VBA.Trim(cReplaceValue) = "х", "***", IIf(VBA.Len(cReplaceValue) = 3, cReplaceValue, VBA.Right(cReplaceValue + "000", 3)))
                                End If
                                If VBA.Val(aCol(nCol)) = 3 And aRdList(nRd) = 2 Then 'ППП(3)ПРЗ(4)КЦСР(7)КВР(3)КОСГУ(3)
                                  cReplaceValue = IIf(VBA.Trim(cReplaceValue) = "x" Or VBA.Trim(cReplaceValue) = "х", "***|****|*******|***|***", IIf(VBA.Len(cReplaceValue) = 20, VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 14), 7) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 20), 3), VBA.Right(cReplaceValue + "000|0000|0000000|000|000", 24)))
                                End If
                        End If

                        If cFormCode = "280" Then
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 1 Then ' АП(3)|ПГР(3)|ПСТ(5)|ЭЛМ(2)|ПРГ(4)|КОСГУ(3)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 6), 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 11), 5) + cSep + VBA.Right(VBA.Left(cReplaceValue, 13), 2) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 4) + cSep + VBA.Right(cReplaceValue, 3)
                                End If
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 2 Then 'ППП(3)|Р,Пр(4)|КЦСР(7)|КВР(3)|КОСГУр(3)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 14), 7) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 3) + cSep + VBA.Right(cReplaceValue, 3)
                                End If
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 3 Then 'АП(3)|ПГР(4)|ПСТ(4)|ЭЛМ(2)|КВИ(4)|КОСГУ(3)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 11), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 13), 2) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 4) + cSep + VBA.Right(cReplaceValue, 3)
                                End If
                        End If
                        If cFormCode = "482" Then
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 1 Then ' АП(3)|КД(17)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 17)
                                End If
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 2 Then 'ППП(3)|ПРЗ(4)|КЦСР(7)|КВР(3)|КОСГУ(3)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 14), 7) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 3) + cSep + VBA.Right(cReplaceValue, 3)
                                End If
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 3 Then 'АП(3)|КИФД(17)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 17)
                                End If
                        End If
                        If cFormCode = "125" Or cFormCode = "425" Then '0503125
                           If nMode = 4 Then ' Выгрузка под Свод-КС
                                If VBA.Val(aCol(nCol)) = 1 Then 'Наименование контрагента
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) > 0, cReplaceValue, " ")
                                End If
                                If VBA.Val(aCol(nCol)) = 2 Then 'глава по БК
                                  cReplaceValue = VBA.Left(cReplaceValue + "000", 3)
                                  cTmp2 = cReplaceValue
                                End If
                                If VBA.Val(aCol(nCol)) = 3 Then 'ОКАТО
                                  cReplaceValue = VBA.Left(cReplaceValue + "           ", 11)
                                  cTmp3 = cReplaceValue
                                End If
                                If VBA.Val(aCol(nCol)) = 4 Then 'Эл. бюджета
                                  cReplaceValue = VBA.Right("00" + cReplaceValue, 2)
                                  cTmp4 = cReplaceValue
                                End If
                                If VBA.Val(aCol(nCol)) = 5 Then 'Номер счета бюджетного учета только 17 символов
                                  If cFormCode = "125" Then
                                    cReplaceValue = VBA.Left(cReplaceValue + "00000000000000000", 17)
                                  Else '425
                                    cReplaceValue = VBA.Left(cReplaceValue + "00000000000000000", 17)
                                    cTmp5 = cReplaceValue
                                    If aRdList(nRd) = 1 Or aRdList(nRd) = 3 Then
                                        cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 14)
                                    Else
                                        cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 14), 7) + cSep + VBA.Right(cReplaceValue, 3)
                                    End If
                                  End If
                                End If
                                If VBA.Val(aCol(nCol)) = 6 Then 'сумма по дебету
                                  cReplaceValue = VBA.Replace(IIf(cReplaceValue = "", "0.00", cReplaceValue), ",", ".")
                                End If
                                If VBA.Val(aCol(nCol)) = 7 Then 'сумма по кредиту + ||признак расчета денеженый=1, неденежный=0 - пока не заполняем
                                 If cFormCode = "125" Then
                                  cReplaceValue = VBA.Replace(IIf(cReplaceValue = "", "0.00", cReplaceValue), ",", ".") + cSep + "" + cSep
                                 Else '425
                                  cReplaceValue = VBA.Replace(IIf(cReplaceValue = "", "0.00", cReplaceValue), ",", ".")
                                 End If
                                End If
                                If VBA.Val(aCol(nCol)) = 8 Then 'Код корреспонд. счета БУ + последний элемент составного ключа которого нет в БКС
                                 If cFormCode = "125" Then
                                  cReplaceValue = VBA.Right("000000000" + cReplaceValue, 9) + VBA.Right("00000000" + VBA.Trim(VBA.Str(nRd + nRow)), 8)
                                 Else '425
                                 cReplaceValue = VBA.Right("000000000" + cReplaceValue, 9) + cSep + "" + cSep + cTmp1 + cTmp2 + cTmp3 + cTmp4 + cTmp5 + VBA.Right("000000000" + cReplaceValue, 9) + VBA.Right("00000000" + VBA.Trim(VBA.Str(nRd + nRow)), 8)
                                 End If
                                End If
                           Else              ' Выгрузка МФ РФ
                                If VBA.Val(aCol(nCol)) = 2 Then 'ОКАТО бюджета(8)|ППП ГлаваБК(3)
                                  cReplaceValue = IIf(VBA.CStr(oData.Cells(nRow, nKeyCol).Value) = "5", "********|***", IIf(VBA.Len(VBA.Left(VBA.CStr(oCurrSheet.Range("H10")), 8)) > 0, VBA.Left(VBA.CStr(oCurrSheet.Range("H10")), 8), "00000000") + cSep + IIf(VBA.Len(VBA.Left(cReplaceValue, 3)) > 0, VBA.Left(cReplaceValue, 3), "***"))
                                End If
                                If VBA.Val(aCol(nCol)) = 3 Then 'ОКАТО(8)
                                  cReplaceValue = IIf(VBA.Len(VBA.Left(cReplaceValue, 8)) > 0, VBA.Left(cReplaceValue, 8), "********")
                                End If
                                If VBA.Val(aCol(nCol)) = 4 Then 'элемента бюджета(2)
                                  cReplaceValue = IIf(VBA.Len(VBA.Left(cReplaceValue, 2)) > 0, VBA.Left(cReplaceValue, 2), "**")
                                End If
                                If VBA.Val(aCol(nCol)) = 5 Then 'Номер счета бюждетного счета ППП| КБК| КВД| Код счета | КОСГУ
                                  cReplaceValue = IIf(VBA.Len(VBA.Left(cReplaceValue, 9)) > 0, "***" + cSep + "**************" + cSep + VBA.Left(cReplaceValue + VBA.Space(26 - VBA.Len(cReplaceValue)), 1) + cSep + VBA.Right(VBA.Left(cReplaceValue + VBA.Space(26 - VBA.Len(cReplaceValue)), 6), 5) + cSep + VBA.Right(VBA.Left(cReplaceValue + VBA.Space(26 - VBA.Len(cReplaceValue)), 9), 3), "***|**************|*|*****|***")
                                End If
                                If VBA.Val(aCol(nCol)) = 8 Then 'Код корреспондирующего счета бюджетного учета  КВД| Код счета | КОСГУ
                                  cReplaceValue = IIf(VBA.Len(VBA.Left(cReplaceValue, 9)) > 0, VBA.Left(cReplaceValue + VBA.Space(9 - VBA.Len(cReplaceValue)), 1) + cSep + VBA.Right(VBA.Left(cReplaceValue + VBA.Space(9 - VBA.Len(cReplaceValue)), 6), 5) + cSep + VBA.Right(cReplaceValue + VBA.Space(9 - VBA.Len(cReplaceValue)), 3), "*|*****|***")
                                End If
                           End If
                        End If
                        If ((cFormCode = "164" or cFormCode = "464")  and nMode <> 5 ) Then 'Блок для 0503164, 0503364
                                If VBA.Len(cReplaceValue) = 20 Then 'Выгрузка  КБК 20 знаков с разбивкой на части
                                        ' 1-ый раздел
                                        If (VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 1) Then ' АП(3)|КД(17)
                                                cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 17)
                                        End If
                                        ' 2-ый раздел
                                        If (VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 2) Then 'ППП(3)|ПРз(4)|КЦСР(7)|КВР(3)|КОСГУ(3)
                                                cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 14), 7) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 3) + cSep + VBA.Right(cReplaceValue, 3)
                                        End If
                                        ' 3-ый раздел
                                        If (VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 3) Then 'АП(3)|КИФД(17)
                                                cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 17)
                                        End If

                                End If
                        End If 
                        If cFormCode = "164" And nMode = 5 Then
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 1 Then ' Код главы(3)|Код группы/подгруппы/статьи/подстатьи/элемента (10)|
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 13), 10)
                                End If
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 2 Then 'Код главы(3)| Код раздела/подраздела(4)|КЦСР(3)|
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 10), 3)
                                End If
                                If VBA.Val(aCol(nCol)) = 1 And aRdList(nRd) = 3 Then 'Код главы(3)|Код группы/подгруппы/статьи/вида(14)
                                  cReplaceValue = VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 14)
                                End If
                        End If
                        cDataRow = cDataRow + VBA.IIf(cDataRow = "", "", IIf(cFormCode = "125" And nMode = 4 And (VBA.Val(aCol(nCol)) = 2 Or VBA.Val(aCol(nCol)) = 3 Or VBA.Val(aCol(nCol)) = 4 Or VBA.Val(aCol(nCol)) = 5 Or VBA.Val(aCol(nCol)) = 8), "", cSep)) _
                            + cReplaceValue
                        oData.Cells(nRow, VBA.Val(aCol(nCol))).Clear
                    End If
                Next nCol
            End If
            If cDataRow <> "" Then
                Call PrintFile(cSavePath + cSaveFile, 1, _
                    VBA.IIf(bSepFirst, cSep, "") + cDataRow + VBA.IIf(bSepLast, cSep, ""))
            End If
        Next nRow
        If nMode <> 1 Or nMode <> 4 Then
          If nMode <> 4 And nMode <> 5 Then
            Call PrintFile(cSavePath + cSaveFile, 1, "#")
          End If
        End If
    Next nRd
    ' Заключительная часть
    cFooter = ScriptGet(oWorkSheet, "OUT_COMMENTS")
    If nMode = 1 Then
        Call PrintFile(cSavePath + cSaveFile, 1, "РД=80")
        Call PrintFile(cSavePath + cSaveFile, 1, "ППО=" + ScriptGet(oWorkSheet, "APPLICATION_INFO"))
        If cFooter <> "" Then
            Call PrintFile(cSavePath + cSaveFile, 1, cFooter)
        End If
    Else
        If nMode <> 4 And nMode <> 5 Then
                Call PrintFile(cSavePath + cSaveFile, 1, "#&")
                If cFooter <> "" Then
                        Call PrintFile(cSavePath + cSaveFile, 1, cFooter)
                End If
                Call PrintFile(cSavePath + cSaveFile, 1, "#")
                Call PrintFile(cSavePath + cSaveFile, 1, "#~")
                Call PrintFile(cSavePath + cSaveFile, 1, "ППО=" + ScriptGet(oWorkSheet, "APPLICATION_INFO"))
                Call PrintFile(cSavePath + cSaveFile, 1, "#")
                Call PrintFile(cSavePath + cSaveFile, 1, "##")
        End If
    End If
    If nMode = 1 Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Файл выгрузки:" + VBA.vbNewLine + cFullPath + cSaveFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
    Else
        Application.StatusBar = "Формирование файла выгрузки. Архивирование ..."
        cArjFile = GetFileName(1, oCurrSheet, False, nMode)
        nAnswer = VBA.MsgBox("Выполнить архивирование с помощью ""ARJ.EXE"" в архив:" + VBA.vbNewLine + cFullPath + cArjFile, VBA.vbYesNo + VBA.vbInformation, "Внимание")
        If nAnswer = 6 Then
            cEnvPath = GetEnvironment("Path")
            aEnvPath = VBA.Split(cEnvPath, ";")
            bArjExe = False
            For nIndex = 0 To UBound(aEnvPath)
                cEnvPath = VBA.Trim(aEnvPath(nIndex))
                cEnvPath = cEnvPath + VBA.IIf(VBA.Right(cEnvPath, 1) <> "\", "\", "")
                cEnvPath = GetShortPath(cEnvPath)
                If VBA.Dir(cEnvPath + "arj.exe") <> "" Then
                    bArjExe = True
                    cArjExe = cEnvPath + "arj.exe"
                    Exit For
                End If
            Next nIndex
            If Not bArjExe Then
                Call VBA.MsgBox("Не удалось выполнить архивирование с помощью ""ARJ.EXE"" в архив, так как" + VBA.vbNewLine + "не удалось найти архиватор в системных каталогах и в каталогах по умолчанию." + VBA.vbNewLine + "Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Файл выгрузки:" + VBA.vbNewLine + cFullPath + cSaveFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
            Else
                Set WshShell = CreateObject("WScript.Shell")
                cCmd = cArjExe + " a -y -e " + cSavePath + cArjFile + " " + cSavePath + cSaveFile
                RetVal = WshShell.Run(cCmd, 0, True)
                If VBA.Dir(cSavePath + cSaveFile) <> "" Then VBA.Kill (cSavePath + cSaveFile)
                Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Архив выгрузки:" + VBA.vbNewLine + cFullPath + cArjFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
            End If
        Else
            Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Файл выгрузки:" + VBA.vbNewLine + cFullPath + cSaveFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
        End If
    End If
Quit:
    If Not oWorkSheet Is Nothing Then
        oWorkSheet.Delete
    End If
    oCurrSheet.Select
    Application.StatusBar = False
    oCurrBook.Saved = True
    Application.ThisWorkbook.Saved = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
ErrMain:
    Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена. " + VBA.vbNewLine + "Номер: " + VBA.Str(Err.Number) + VBA.vbNewLine + "Источник: " + Err.Source + VBA.vbNewLine + "Описание: " + Err.Description, VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
    GoTo Quit
End Sub
'---------------------------------------------------------------------------------------------------------------
' Сортировка для MS Office 2003 и ниже
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadDataSort2003(ByVal oWorkSheet As Worksheet, ByVal oData As Range, ByRef aColSort() As String)
Dim nCol, nShift, nTop, nHeight, nLeft, nWidth As Long
Dim aRef(2) As String

    nTop = oData.Cells(1, 1).Row
    nLeft = oData.Cells(1, 1).column
    nHeight = oData.Rows.count
    nWidth = oData.Columns.count
    oData.Select
    Selection.UnMerge
    If VBA.IsArray(aColSort) Then
        For nCol = 0 To UBound(aRef)
            aRef(nCol) = ""
        Next nCol
        For nCol = 0 To UBound(aColSort)
            If nCol > 2 Then Exit For
            nShift = VBA.Val(aColSort(nCol)) - 1
            If nShift >= 0 And nShift < nWidth Then
                aRef(nCol) = oWorkSheet.Cells(nTop, nLeft + nShift).Address
            End If
        Next nCol
        If aRef(0) <> "" And aRef(1) <> "" And aRef(2) <> "" Then
            Selection.Sort Key1:=Range(aRef(0)), Order1:=xlAscending, Key2:=Range(aRef(1)), Order2:=xlAscending, Key3:=Range(aRef(2)), Order3:=xlAscending, Header:=xlGuess, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
        End If
        If aRef(0) <> "" And aRef(1) <> "" And aRef(2) = "" Then
            Selection.Sort Key1:=Range(aRef(0)), Order1:=xlAscending, Key2:=Range(aRef(1)), Order2:=xlAscending, Header:=xlGuess, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortTextAsNumbers
        End If
        If aRef(0) <> "" And aRef(1) = "" And aRef(2) = "" Then
            Selection.Sort Key1:=Range(aRef(0)), Order1:=xlAscending, Header:=xlGuess, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
        End If
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' Сортировка для MS Office 2007 и выше
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadDataSort2007(ByVal oWorkSheet As Worksheet, ByVal oData As Range, ByRef aColSort() As String)
Dim nCol, nShift, nTop, nHeight, nLeft, nWidth As Long
    nTop = oData.Cells(1, 1).Row
    nLeft = oData.Cells(1, 1).column
    nHeight = oData.Rows.count
    nWidth = oData.Columns.count
    oData.Select
    Selection.UnMerge
    If VBA.IsArray(aColSort) Then
        With oWorkSheet.Sort
            .SortFields.Clear
            For nCol = 0 To UBound(aColSort)
                nShift = VBA.Val(aColSort(nCol)) - 1
                If nShift >= 0 And nShift < nWidth Then
                    .SortFields.Add Key:=oWorkSheet.Range(oWorkSheet.Cells(nTop, nLeft + nShift).Address + ":" + oWorkSheet.Cells(nTop + nHeight - 1, nLeft + nShift).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
                End If
            Next nCol
            .SetRange oWorkSheet.Range(oWorkSheet.Cells(nTop - 1, nLeft).Address + ":" + oWorkSheet.Cells(nTop + nHeight - 1, nLeft + nWidth - 1).Address)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате БКС
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadFormatBKS()
    Call UnloadData(1)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате МФ РФ
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadFormatMF()
    Call UnloadData(2)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате Месячной формы МФ РФ
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadFormatMFRepMonth()
    Call UnloadData(3)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате Свод-КС
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadFormatSvod()
    Call UnloadData(4)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате ДФ г.Москва
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadFormatDF()
    Call UnloadData(5)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате МФ РФ для формы 0503324
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadMF_324()
    Call UnloadData324(2)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка в формате БКС для формы 0503324
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadBKS_324()
    Call UnloadData324(1)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Выгрузка данных для фориы 0503324
' EdiS\19.11.10\
'---------------------------------------------------------------------------------------------------------------
Sub UnloadData324(ByVal nMode As Long)
Dim cDecimal, cSavePath, cFullPath, cSaveFile, cFormCode, cRdList, cColList, cColSort, cKeyCol, cKeyList, cSep, cSepMode, cDataRow As String
Dim cFooter, cArjFile, cEnvPath, cArjExe, cCmd, cReplaceList, cReplaceValue, cCol, cDataRowT, cTmp1, cTmp2, cTmp3, cTmp4, cTmp5 As String
Dim oCurrSheet, oWorkSheet As Worksheet
Dim oCurrBook As Workbook
Dim oData As Range
Dim nTop, nLeft, nHeight, nWidth, nCol, nShift, nRow, nIndex, nRd, nKeyCol, nAnswer, RetVal, nReplace
Dim aColSort() As String, aRdList() As String, aColList() As String, aKeyList() As String, aCol() As String, aEnvPath() As String, aReplaceList() As String, aReplaceValue() As String
Dim bSepFirst, bSepLast, bArjExe As Boolean
Dim oFolder As Variant
Dim WshShell As Object
    
    On Error GoTo ErrMain
    cDecimal = GetLocalInfo(LOCALE_DECIMAL)
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Выберем Лист с именем "Раздел1 (1)"
    Application.ActiveWorkbook.Worksheets("Раздел1 (1)").Select
    Set oCurrBook = Application.ActiveWorkbook
    Set oCurrSheet = Application.ActiveSheet
    ' Если не задан код формы - выгрузки нет
    If ScriptGet(oCurrSheet, "OUT_FORM_CODE") = "" Or Not ExistsNamesSheet(oCurrSheet, "DATA_SECTION") Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена." + VBA.vbNewLine + "Неизвестная отчетная форма.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        Exit Sub
    End If
    oCurrSheet.Select
    oCurrSheet.Copy After:=oCurrBook.Sheets(oCurrBook.Sheets.count)
    Set oWorkSheet = Application.ActiveSheet
    ' Имя файла для выгрузки
    cSaveFile = GetFileName(0, oCurrSheet, False, nMode)
    oFolder = Application.GetSaveAsFilename(InitialFileName:=cSaveFile, FileFilter:="Текстовый файл,*.txt", Title:="Выгрузка данных страницы в файл формата " + VBA.IIf(nMode = 1, "БЮДЖЕТ-КС", "МФ РФ"))
    If oFolder = False Then
        GoTo Quit
    End If
    
    nIndex = 0
    Do While VBA.InStr(nIndex + 1, oFolder, "\") > 0
        nIndex = VBA.InStr(nIndex + 1, oFolder, "\")
    Loop
    
    If nIndex = 0 Then
        Call VBA.MsgBox("Выгрузка не выполнена. Некорректно указан путь для выгрузки.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo Quit
    End If
    
    cSavePath = VBA.Left(oFolder, nIndex)
    cFullPath = cSavePath
    cSavePath = GetShortPath(cSavePath)
    If VBA.Dir(cSavePath, VBA.vbDirectory) = "" Then Call VBA.MkDir(cSavePath)
    oFolder = VBA.Trim(VBA.Mid(oFolder, nIndex + 1))
    If oFolder = cSaveFile Or oFolder = "" Then
        cSaveFile = GetFileName(0, oCurrSheet, True, nMode)
    Else
        cSaveFile = oFolder
    End If
    
    Set oData = oWorkSheet.Range("DATA_SECTION")
    nTop = oData.Cells(1, 1).Row
    nLeft = oData.Cells(1, 1).column
    nHeight = oData.Rows.count
    nWidth = oData.Columns.count
    
    ' настройки
    cFormCode = ScriptGet(oWorkSheet, "OUT_FORM_CODE")
    cRdList = ScriptGet(oWorkSheet, "OUT_RAZDEL_LIST")
    aRdList = VBA.Split(cRdList, "#")
   
    cColList = ScriptGet(oWorkSheet, "OUT_COLUMN_LIST")
    cColSort = ScriptGet(oWorkSheet, "OUT_COLUMN_SORT")
    aColList = VBA.Split(cColList, "#")
    aColSort = VBA.Split(cColSort, ",")
    
    cSep = ScriptGet(oWorkSheet, "OUT_SEPARATOR")
    cSepMode = ScriptGet(oWorkSheet, "OUT_SEPARATOR_MODE")
    bSepFirst = (VBA.Val(cSepMode) And 1) > 0
    bSepLast = (VBA.Val(cSepMode) And 2) > 0
    
    cKeyCol = ScriptGet(oWorkSheet, "OUT_KEY_COLUMN")
    nKeyCol = VBA.Val(cKeyCol)
    cKeyList = ScriptGet(oWorkSheet, "OUT_KEY_LIST")
    aKeyList = VBA.Split(cKeyList, "#")
    cReplaceList = ScriptGet(oWorkSheet, "OUT_REPLACE_LIST")
    aReplaceList = VBA.Split(cReplaceList, "#")
    ' проверки
    If Not VBA.IsArray(aRdList) Or Not VBA.IsArray(aColList) Or Not VBA.IsArray(aKeyList) Or nKeyCol <= 0 Or nKeyCol > nWidth Or cSep = "" Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена." + VBA.vbNewLine + "Обнаружены некорректные описания секций содержательной части отчетной формы.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo Quit
    End If
    If UBound(aRdList) <> UBound(aColList) Or UBound(aRdList) <> UBound(aKeyList) Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена." + VBA.vbNewLine + "Обнаружены некорректные описания секций содержательной части отчетной формы.", VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo Quit
    End If
    ' сортировка
    If VBA.Val(Application.Version) >= 12 Then ' 2007
        Call UnloadDataSort2007(oWorkSheet, oData, aColSort)
    Else ' 2003 и ниже
        Call UnloadDataSort2003(oWorkSheet, oData, aColSort)
    End If
    ' Заголовочная часть
    If nMode = 1 Then
        Call PrintFile(cSavePath + cSaveFile, 0, ScriptGet(oWorkSheet, "SUBJECT_NAME"))
        Call PrintFile(cSavePath + cSaveFile, 1, "ИСТ=" + ScriptGet(oWorkSheet, "SUBJECT_CODE"))
        Call PrintFile(cSavePath + cSaveFile, 1, "ДТ=" + VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate")) + 1))
    Else
        Call PrintFile(cSavePath + cSaveFile, 0, "#%")
        Call PrintFile(cSavePath + cSaveFile, 1, "КОДФ=" + cFormCode)
        Call PrintFile(cSavePath + cSaveFile, 1, "ПРД=" + GetPRD(VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate")))))
        Call PrintFile(cSavePath + cSaveFile, 1, "РДТ=" + VBA.CStr(VBA.CDate(ScriptGet(oWorkSheet, "dDate")) + 1))
        Call PrintFile(cSavePath + cSaveFile, 1, "ВИД=" + ScriptGet(oWorkSheet, "OBJECT_SOURCE_TYPE"))
        Call PrintFile(cSavePath + cSaveFile, 1, "ИСТ=" + ScriptGet(oWorkSheet, "SUBJECT_CODE"))
        Call PrintFile(cSavePath + cSaveFile, 1, "#")
    End If
    ' Содержательная часть
    For nRd = 0 To UBound(aRdList)
        If nMode = 1 Then
            Call PrintFile(cSavePath + cSaveFile, 1, "РД=" + VBA.Trim(VBA.Str(VBA.Val(aRdList(nRd)))))
            ' Подготовимся к выгрузке Раздела 2
            If nRd = 1 Then
                If Not oWorkSheet Is Nothing Then
                    oWorkSheet.Delete
                End If
                ' ' Выберем Лист с именем "Раздел2 (2)"
                Application.ActiveWorkbook.Worksheets("Раздел2 (2)").Select
                Set oCurrSheet = Application.ActiveSheet
                oCurrSheet.Copy After:=oCurrBook.Sheets(oCurrBook.Sheets.count)
                Set oWorkSheet = Application.ActiveSheet
                
                Set oData = oWorkSheet.Range("DATA_SECTION")
                nTop = oData.Cells(1, 1).Row
                nLeft = oData.Cells(1, 1).column
                nHeight = oData.Rows.count
                nWidth = oData.Columns.count
             End If
        Else
            Call PrintFile(cSavePath + cSaveFile, 1, "#@")
            Call PrintFile(cSavePath + cSaveFile, 1, "ТБ=" + aRdList(nRd))
            Call PrintFile(cSavePath + cSaveFile, 1, "#$")
            ' Подготовимся к выгрузке Раздела 2
            If nRd = 1 Then
                If Not oWorkSheet Is Nothing Then
                    oWorkSheet.Delete
                End If
                ' ' Выберем Лист с именем "Раздел2 (2)"
                Application.ActiveWorkbook.Worksheets("Раздел2 (2)").Select
                Set oCurrSheet = Application.ActiveSheet
                oCurrSheet.Copy After:=oCurrBook.Sheets(oCurrBook.Sheets.count)
                Set oWorkSheet = Application.ActiveSheet
                
                Set oData = oWorkSheet.Range("DATA_SECTION")
                nTop = oData.Cells(1, 1).Row
                nLeft = oData.Cells(1, 1).column
                nHeight = oData.Rows.count
                nWidth = oData.Columns.count
             End If
        End If
        For nRow = 1 To nHeight
            Application.StatusBar = "Формирование файла выгрузки. Выполнено: " + VBA.Format((nRd * nHeight + nRow) / ((UBound(aRdList) + 1) * nHeight), "0%")
            cDataRow = ""
            If VBA.InStr("," + aKeyList(nRd) + ",", "," + VBA.CStr(oData.Cells(nRow, nKeyCol).Value) + ",") > 0 Then
                aCol = VBA.Split(aColList(nRd), ",")
                For nCol = 0 To UBound(aCol)
                    If VBA.Val(aCol(nCol)) >= 1 And VBA.Val(aCol(nCol)) <= nWidth Then
                        cReplaceValue = VBA.CStr(oData.Cells(nRow, VBA.Val(aCol(nCol))).Value)

                        cCol = VBA.Trim(aCol(nCol))
                        For nReplace = 0 To UBound(aReplaceList)
                            If VBA.Left(VBA.Trim(aReplaceList(nReplace)), VBA.Len(cCol) + 1) = (cCol + ";") Then
                                aReplaceValue = VBA.Split(aReplaceList(nReplace), ";")
                                If UBound(aReplaceValue) = 2 Then
                                    If VBA.Trim(VBA.LCase(cReplaceValue)) = VBA.Trim(VBA.LCase(aReplaceValue(1))) Then
                                        cReplaceValue = VBA.Trim(aReplaceValue(2))
                                        Exit For
                                    End If
                                End If
                            End If
                        Next nReplace
                        If cFormCode = "424" Then '0503324
                                If VBA.Val(aCol(nCol)) = 2 And aRdList(nRd) = 1 Then 'Код главы по БК (3)
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) = 3, cReplaceValue, VBA.Right(cReplaceValue + "000", 3))
                                End If
                                If VBA.Val(aCol(nCol)) = 3 And aRdList(nRd) = 1 Then 'Код целевой статьи расходов по БК(7)
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) = 7, cReplaceValue, VBA.Right(cReplaceValue + "0000000", 7))
                                End If
                                If VBA.Val(aCol(nCol)) = 4 And aRdList(nRd) = 1 Then 'Код доходов по БК = АП(3)|КД(17)
                                  cReplaceValue = IIf(VBA.Len(cReplaceValue) = 20, VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(cReplaceValue, 17), VBA.Right(cReplaceValue + "000|00000000000000000", 21))
                                End If
                                If VBA.Val(aCol(nCol)) = 2 And aRdList(nRd) = 2 Then 'Код главы по БК (3)
                                  cReplaceValue = IIf(VBA.Trim(cReplaceValue) = "x" Or VBA.Trim(cReplaceValue) = "х", "***", IIf(VBA.Len(cReplaceValue) = 3, cReplaceValue, VBA.Right(cReplaceValue + "000", 3)))
                                End If
                                If VBA.Val(aCol(nCol)) = 3 And aRdList(nRd) = 2 Then 'ППП(3)ПРЗ(4)КЦСР(7)КВР(3)КОСГУ(3)
                                  cReplaceValue = IIf(VBA.Trim(cReplaceValue) = "x" Or VBA.Trim(cReplaceValue) = "х", "***|****|*******|***|***", IIf(VBA.Len(cReplaceValue) = 20, VBA.Left(cReplaceValue, 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 7), 4) + cSep + VBA.Right(VBA.Left(cReplaceValue, 14), 7) + cSep + VBA.Right(VBA.Left(cReplaceValue, 17), 3) + cSep + VBA.Right(VBA.Left(cReplaceValue, 20), 3), VBA.Right(cReplaceValue + "000|0000|0000000|000|000", 24)))
                                End If
                        End If

                        cDataRow = cDataRow + VBA.IIf(cDataRow = "", "", cSep) + cReplaceValue
                        oData.Cells(nRow, VBA.Val(aCol(nCol))).Clear
                    End If
                Next nCol
            End If
            If cDataRow <> "" Then
                Call PrintFile(cSavePath + cSaveFile, 1, VBA.IIf(bSepFirst, cSep, "") + cDataRow + VBA.IIf(bSepLast, cSep, ""))
            End If
        Next nRow
        If nMode <> 1 Or nMode <> 4 Then
          If nMode <> 4 And nMode <> 5 Then
            Call PrintFile(cSavePath + cSaveFile, 1, "#")
          End If
        End If
    Next nRd
    ' Заключительная часть
    cFooter = ScriptGet(oWorkSheet, "OUT_COMMENTS")
    If nMode = 1 Then
        Call PrintFile(cSavePath + cSaveFile, 1, "РД=80")
        Call PrintFile(cSavePath + cSaveFile, 1, "ППО=" + ScriptGet(oWorkSheet, "APPLICATION_INFO"))
        If cFooter <> "" Then
            Call PrintFile(cSavePath + cSaveFile, 1, cFooter)
        End If
    Else
        Call PrintFile(cSavePath + cSaveFile, 1, "#&")
        If cFooter <> "" Then
             Call PrintFile(cSavePath + cSaveFile, 1, cFooter)
        End If
        Call PrintFile(cSavePath + cSaveFile, 1, "#")
        Call PrintFile(cSavePath + cSaveFile, 1, "#~")
        Call PrintFile(cSavePath + cSaveFile, 1, "ППО=" + ScriptGet(oWorkSheet, "APPLICATION_INFO"))
        Call PrintFile(cSavePath + cSaveFile, 1, "#")
        Call PrintFile(cSavePath + cSaveFile, 1, "##")
    End If
    If nMode = 1 Then
        Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Файл выгрузки:" + VBA.vbNewLine + cFullPath + cSaveFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
    Else
        Application.StatusBar = "Формирование файла выгрузки. Архивирование ..."
        cArjFile = GetFileName(1, oCurrSheet, False, nMode)
        nAnswer = VBA.MsgBox("Выполнить архивирование с помощью ""ARJ.EXE"" в архив:" + VBA.vbNewLine + cFullPath + cArjFile, VBA.vbYesNo + VBA.vbInformation, "Внимание")
        If nAnswer = 6 Then
            cEnvPath = GetEnvironment("Path")
            aEnvPath = VBA.Split(cEnvPath, ";")
            bArjExe = False
            For nIndex = 0 To UBound(aEnvPath)
                cEnvPath = VBA.Trim(aEnvPath(nIndex))
                cEnvPath = cEnvPath + VBA.IIf(VBA.Right(cEnvPath, 1) <> "\", "\", "")
                cEnvPath = GetShortPath(cEnvPath)
                If VBA.Dir(cEnvPath + "arj.exe") <> "" Then
                    bArjExe = True
                    cArjExe = cEnvPath + "arj.exe"
                    Exit For
                End If
            Next nIndex
            If Not bArjExe Then
                Call VBA.MsgBox("Не удалось выполнить архивирование с помощью ""ARJ.EXE"" в архив, так как" + VBA.vbNewLine + "не удалось найти архиватор в системных каталогах и в каталогах по умолчанию." + VBA.vbNewLine + "Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Файл выгрузки:" + VBA.vbNewLine + cFullPath + cSaveFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
            Else
                Set WshShell = CreateObject("WScript.Shell")
                cCmd = cArjExe + " a -y -e " + cSavePath + cArjFile + " " + cSavePath + cSaveFile
                RetVal = WshShell.Run(cCmd, 0, True)
                If VBA.Dir(cSavePath + cSaveFile) <> "" Then VBA.Kill (cSavePath + cSaveFile)
                Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Архив выгрузки:" + VBA.vbNewLine + cFullPath + cArjFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
            End If
        Else
            Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ успешно завершена. Файл выгрузки:" + VBA.vbNewLine + cFullPath + cSaveFile, VBA.vbOKOnly + VBA.vbInformation, "Информация")
        End If
    End If
Quit:
    If Not oWorkSheet Is Nothing Then
        oWorkSheet.Delete
    End If
    oCurrSheet.Select
    Application.StatusBar = False
    oCurrBook.Saved = True
    Application.ThisWorkbook.Saved = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
ErrMain:
    Call VBA.MsgBox("Выгрузка страницы """ + oCurrSheet.name + """ не выполнена. " + VBA.vbNewLine + "Номер: " + VBA.Str(Err.Number) + VBA.vbNewLine + "Источник: " + Err.Source + VBA.vbNewLine + "Описание: " + Err.Description, VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
    GoTo Quit
End Sub
'---------------------------------------------------------------------------------------------------------------
