Attribute VB_Name = "CashPlanInit"
Option Explicit

Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_DECIMAL = &HE
Public oConnection, tPhaseBegin

#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
#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
#End If

' -------------------------------------------------------------------------------------------------------
Sub ChangeToolbar(ByVal nMode As Integer)
    Dim bFound As Boolean, oBar As Object
    
    On Error GoTo doError
    
    If Application.Visible And Application.ScreenUpdating And Application.DisplayAlerts Then
        bFound = False
        For Each oBar In Application.CommandBars
            If oBar.Name = "CashPlanMenu" Then bFound = True
        Next
        If bFound Then
            With Application.CommandBars("CashPlanMenu").Controls(1)
                Select Case nMode
                Case 1:
                    If .FaceId = 342 Then .FaceId = 352
                Case 2:
                    If .FaceId = 352 Then .FaceId = 342
                End Select
            End With
        End If
    End If
    
    Exit Sub
    
doError:
    Call ShowErrorEvent("ChangeToolbar")
End Sub
' -------------------------------------------------------------------------------------------------------
Function CheckArray(ByRef aTest As Variant) As Boolean
    Dim nBound As Long, bIsArray As Boolean
    
    bIsArray = False
    If VBA.IsArray(aTest) Then
        On Error GoTo doError
        nBound = UBound(aTest, 1)
        bIsArray = True
    End If

doError:
    CheckArray = bIsArray
End Function
' -------------------------------------------------------------------------------------------------------
Function ExistsNames(ByVal oBook As Workbook, ByVal cName As String) As Boolean
    Dim i As Integer
    
    On Error GoTo doError
    
    For i = 1 To oBook.Names.Count
        If oBook.Names(i).Name = cName Then
            ExistsNames = True
            Exit Function
        End If
    Next
    ExistsNames = False
    
    Exit Function
    
doError:
    ExistsNames = False
    Call ShowErrorEvent("ExistsNames")
End Function
' -------------------------------------------------------------------------------------------------------
Function ExistsWorksheet(ByVal oBook As Workbook, ByVal cName As String) As Boolean
    Dim oSheet As Worksheet, bFlag As Boolean
    
    On Error GoTo doError
    
    bFlag = False
    For Each oSheet In oBook.Sheets
        If oSheet.Name = cName Then bFlag = True
    Next oSheet
    ExistsWorksheet = bFlag
    
    Exit Function
    
doError:
    ExistsWorksheet = False
    Call ShowErrorEvent("ExistsWorksheet")
End Function
' -------------------------------------------------------------------------------------------------------
Function GetADOVersion() As Double
    Dim ADO, ADOVersion As Double

    On Error GoTo ErrorAdo
    
    Set ADO = CreateObject("ADODB.Connection")
    ADOVersion = VBA.Val(ADO.Version)
    Set ADO = Nothing
    
    On Error GoTo 0
    GoTo ExitFunc

ErrorAdo:
    On Error GoTo 0
    ADOVersion = 0
    
ExitFunc:
    GetADOVersion = ADOVersion
End Function
' -------------------------------------------------------------------------------------------------------
Function GetChar(ByVal nVal As Long, ByVal nCount As Long) As String
    Dim cRet As String, cTran As String, nX As Long
    
    On Error GoTo doError
        
    cTran = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    cRet = ""
    
    nX = nVal
    Do While nX <> 0
        cRet = VBA.Mid$(cTran, (nX Mod 36) + 1, 1) + cRet
        nX = VBA.Int(nX / 36)
    Loop
    
    If VBA.Len(cRet) > nCount Then
        GetChar = VBA.Space$(nCount)
    Else
        GetChar = VBA.IIf(VBA.Len(cRet) < nCount, VBA.String(nCount - VBA.Len(cRet), "0"), "") + cRet
    End If
    Exit Function

doError:
    GetChar = ""
    Call ShowErrorEvent("GetChar")
End Function
' -------------------------------------------------------------------------------------------------------
Function GetCode(ByVal str As String) As String
    Dim p As String, char As Byte, i As Integer
    
    On Error GoTo doError
    
    str = VBA.Mid(str, 3, VBA.Len(str) - 2)
    p = ""
    For i = 1 To VBA.Len(str)
        char = VBA.Asc(VBA.Mid(str, i, 1))
        p = p + VBA.Chr((char + 7) Xor 7)
    Next i
    
    GetCode = p
    Exit Function

doError:
    GetCode = ""
    Call ShowErrorEvent("GetCode")
End Function
' -------------------------------------------------------------------------------------------------------
Function GetExcelVersion() As String
    Dim nVersion As Double, cVersion As String
    
    On Error GoTo doError
    
    nVersion = VBA.Val(Application.Version)
    Select Case nVersion
    Case 14
        cVersion = "2010"
    Case 12
        cVersion = "2007"
    Case 11
        cVersion = "2003"
    Case 10
        cVersion = "XP (2002)"
    Case 9
        cVersion = "2000"
    Case Else
        cVersion = "версия " + VBA.str(nVersion)
    End Select
    GetExcelVersion = "Microsoft Office Excel " + cVersion
    Exit Function

doError:
    GetExcelVersion = ""
    Call ShowErrorEvent("GetExcelVersion")
End Function
' -------------------------------------------------------------------------------------------------------
Function GetLocalInfo(ByVal nInfo As Long) As String
    Dim cBuffer As String, nRet As String
    
    On Error GoTo doError
    
    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), ""))
    Exit Function

doError:
    GetLocalInfo = ""
    Call ShowErrorEvent("GetLocalInfo")
End Function
' -------------------------------------------------------------------------------------------------------
Function GetRangeFormat(ByVal cFormat As String, ByVal nLen As Long) As String
    Dim cResult As String
    
    On Error GoTo doError
    
    Select Case VBA.UCase(cFormat)
    Case "STRING"
        cResult = "@"
    Case "DATE"
        cResult = "dd.mm.yyyy"
    Case "NUMBER"
        cResult = "#,##0" + VBA.IIf(nLen > 0, "." + VBA.String(nLen, "0"), "")
    Case Else
        cResult = ""
    End Select

    GetRangeFormat = cResult
    Exit Function

doError:
    GetRangeFormat = ""
    Call ShowErrorEvent("GetRangeFormat")
End Function
' -------------------------------------------------------------------------------------------------------
Function GetShortPath(ByVal cFileName As String) As String
    Dim nRes As Long, cPath As String
    
    On Error GoTo doError
    
    cPath = VBA.String$(255, 0)
    nRes = GetShortPathName(cFileName, cPath, 254)
    GetShortPath = VBA.Left$(cPath, nRes)
    Exit Function

doError:
    GetShortPath = ""
    Call ShowErrorEvent("GetShortPath")
End Function
' -------------------------------------------------------------------------------------------------------
Sub GetSplitSign(ByVal cLen As String, ByRef cSign As String, ByRef nLen As Long)
    Dim i As Integer
    
    On Error GoTo doError
    
    cSign = VBA.Replace(cLen, " ", "")
    If VBA.Len(cSign) > 0 Then
        i = 0
        Do While VBA.Mid(cSign, i + 1, 1) = "<" Or VBA.Mid(cSign, i + 1, 1) = ">" Or VBA.Mid(cSign, i + 1, 1) = "="
            i = i + 1
        Loop
        If i > 0 Then
            nLen = VBA.Val(VBA.Mid(cSign, i + 1))
            cSign = VBA.Left(cSign, i)
        Else
            nLen = VBA.Val(cSign)
            cSign = ""
        End If
    Else
        nLen = 0
        cSign = ""
    End If
    Exit Sub

doError:
    Call ShowErrorEvent("GetSplitSign")
End Sub
' -------------------------------------------------------------------------------------------------------
Function GetStrParam(ByVal cParam As String, ByVal nParam As Integer, Optional ByVal cPart As String = "#") As String
    Dim nPos1 As Integer, nPos2 As Integer, i As Long
    
    On Error GoTo doError
    
    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
    Exit Function

doError:
    GetStrParam = ""
    Call ShowErrorEvent("GetStrParam")
End Function
' -------------------------------------------------------------------------------------------------------
Sub InitProtectSheets(ByVal cMode As String)
    Dim oSheet As Worksheet, nVal As Long, cWord As String
    
    On Error GoTo doError
    
    VBA.Randomize
    nVal = VBA.Int(VBA.Rnd() * 100000) * 10000 + VBA.Int(VBA.Rnd() * 100000)
    cWord = GetChar(nVal, 10)

    For Each oSheet In Application.ActiveWorkbook.Worksheets
        Call ScriptSet(oSheet, "protect_word", cWord)
        Call ProtectSheet(1, oSheet)
    Next oSheet
    Exit Sub

doError:
    Call ShowErrorEvent("InitProtectSheets")
End Sub
' -------------------------------------------------------------------------------------------------------
Sub InitScripts(ByVal cMode As String, ByVal cLikeSheet As String)
    Dim bFound As Boolean, nIndex As Long, cCode As String, oSheet As Worksheet _
        , oBook As Workbook, cBK As String
    
    On Error GoTo doError
    
    If cMode = "1" Or cMode = "2" Then
        cBK = VBA.IIf(cMode = "1", "Расходная", "Доходная")
        For Each oBook In Application.Workbooks
            bFound = False
            For nIndex = 1 To oBook.VBProject.VBComponents.Count
                bFound = bFound Or (oBook.VBProject.VBComponents(nIndex).Name = "CashPlanWork")
            Next nIndex
            
            If bFound Then
                For Each oSheet In oBook.Worksheets
                    If VBA.InStr(VBA.UCase(oSheet.Name), cLikeSheet) > 0 Then
                        For nIndex = 1 To oBook.VBProject.VBComponents.Count
                            If oBook.VBProject.VBComponents(nIndex).Name = oSheet.CodeName Then
                                cCode = "" _
                                + VBA.vbNewLine + "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" _
                                + VBA.vbNewLine + "    Dim nCol As Long, oCells As Range" _
                                + VBA.vbNewLine + "    If Target.Row = 1 Then Exit Sub" _
                                + VBA.vbNewLine + "    If Target.Column = 1 Then" _
                                + VBA.vbNewLine + "        Select Case Target.Value" _
                                + VBA.vbNewLine + "        Case ""ДОБАВИТЬ""" _
                                + VBA.vbNewLine + "            Call RowAppend(Me, Target)" _
                                + VBA.vbNewLine + "        Case ""УДАЛИТЬ""" _
                                + VBA.vbNewLine + "            Call RowDelete(Me, Target)" _
                                + VBA.vbNewLine + "        End Select" _
                                + VBA.vbNewLine + "        Cancel = True" _
                                + VBA.vbNewLine + "        Exit Sub" _
                                + VBA.vbNewLine + "    End If"
                                
                                If cLikeSheet = "ЗАЯВ." Or cLikeSheet = "ВЫПЛ." Or cLikeSheet = "ПОСТ." Then
                                    cCode = cCode _
                                    + VBA.vbNewLine + "    If Target.Column = 2 And (Me.Cells(Target.Row, 1).Value = ""ДОБАВИТЬ"" Or Me.Cells(Target.Row, 1).Value = ""УДАЛИТЬ"") Then" _
                                    + VBA.vbNewLine + "        If ProtectSheet(2, Me) = 0 Then" _
                                    + VBA.vbNewLine + "            Exit Sub" _
                                    + VBA.vbNewLine + "        End If" _
                                    + VBA.vbNewLine + "        Application.ScreenUpdating = False" _
                                    + VBA.vbNewLine + "        Application.DisplayAlerts = False" _
                                    + VBA.vbNewLine + "        Select Case Target.Value" _
                                    + VBA.vbNewLine + "        Case """ + cBK + """" _
                                    + VBA.vbNewLine + "            Target.Value = ""Источники""" _
                                    + VBA.vbNewLine + "        Case ""Источники""" _
                                    + VBA.vbNewLine + "            Target.Value = """ + cBK + """" _
                                    + VBA.vbNewLine + "        Case Else" _
                                    + VBA.vbNewLine + "            Target.Value = """ + cBK + """" _
                                    + VBA.vbNewLine + "        End Select"
                                    
                                    cCode = cCode _
                                    + VBA.vbNewLine + "        Call ProtectSheet(1, Me)" _
                                    + VBA.vbNewLine + "        Application.ScreenUpdating = True" _
                                    + VBA.vbNewLine + "        Application.DisplayAlerts = True" _
                                    + VBA.vbNewLine + "        Cancel = True" _
                                    + VBA.vbNewLine + "        Exit Sub" _
                                    + VBA.vbNewLine + "    End If"
                                    
                                    cCode = cCode _
                                    + VBA.vbNewLine + "    If Me.Cells(Target.Row, Target.Column - 1).Value = ""Аналитический признак:"" Then" _
                                    + VBA.vbNewLine + "        If ProtectSheet(2, Me) = 0 Then" _
                                    + VBA.vbNewLine + "            Exit Sub" _
                                    + VBA.vbNewLine + "        End If" _
                                    + VBA.vbNewLine + "        Application.ScreenUpdating = False" _
                                    + VBA.vbNewLine + "        Application.DisplayAlerts = False" _
                                    + VBA.vbNewLine + "        Select Case Target.Cells(1, 1).Value" _
                                    + VBA.vbNewLine + "        Case ""Изменение""" _
                                    + VBA.vbNewLine + "            Target.Cells(1, 1).Value = """"" _
                                    + VBA.vbNewLine + "        Case Else" _
                                    + VBA.vbNewLine + "            Target.Cells(1, 1).Value = ""Изменение""" _
                                    + VBA.vbNewLine + "        End Select"
                                    
                                    cCode = cCode _
                                    + VBA.vbNewLine + "        Call ProtectSheet(1, Me)" _
                                    + VBA.vbNewLine + "        Application.ScreenUpdating = True" _
                                    + VBA.vbNewLine + "        Application.DisplayAlerts = True" _
                                    + VBA.vbNewLine + "        Cancel = True" _
                                    + VBA.vbNewLine + "        Exit Sub" _
                                    + VBA.vbNewLine + "    End If"
                                End If
                                
                                cCode = cCode _
                                + VBA.vbNewLine + "End Sub"
                                
                                With oBook.VBProject.VBComponents(nIndex)
                                    If Not .CodeModule.Find("Worksheet_BeforeDoubleClick", 1, 1, -1, -1) Then
                                        .CodeModule.AddFromString (cCode)
                                    End If
                                End With
                            End If
                        Next nIndex
                    End If
                Next oSheet
                
                With oBook.VBProject.VBComponents.Item(oBook.CodeName)
                    If Not .CodeModule.Find("Workbook_Open", 1, 1, -1, -1) Then
                        .CodeModule.AddFromString ( _
                            "Private Sub Workbook_Open()" _
                            + VBA.vbNewLine + "Call InitToolbarRedo(""1"")" _
                            + VBA.vbNewLine + "End Sub" _
                        )
                    End If
            
                    If Not .CodeModule.Find("Workbook_SheetChange", 1, 1, -1, -1) Then
                        .CodeModule.AddFromString ( _
                            "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" _
                            + VBA.vbNewLine + "Call ChangeToolbar(1)" _
                            + VBA.vbNewLine + "End Sub" _
                        )
                    End If
                End With
            End If
        Next oBook
    End If
    Exit Sub

doError:
    Call ShowErrorEvent("InitScripts")
End Sub
' -------------------------------------------------------------------------------------------------------
Sub InitSettings(ByVal cMode As String)
    Dim oBook As Workbook, oSheet As Worksheet, oRange As Range, cCol As String, nCnt As Long _
        , cAddr As String, nTypeValue As Long, nOperValue As Long, сErrorMessage As String _
        , сFieldName As String, сFieldType As String, сFieldOper As String, сFieldVal1 As String _
        , сFieldVal2 As String, nTagValue As Long, nRow As Long, сError1 As String, сError2 As String
    
    On Error GoTo doError
    
    Application.Calculation = xlCalculationManual
    Set oBook = Application.ActiveWorkbook
    For Each oSheet In oBook.Worksheets
        If oSheet.Visible = -1 Then
            For nCnt = 1 To oSheet.Scripts.Count
                ' #report_end:
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "ks_report_end_") > 0 Then
                    cAddr = VBA.Mid(oSheet.Scripts(nCnt).ID, 1 + VBA.Len("ks_report_end_"))
                    Set oRange = oSheet.Range(cAddr)
                    oSheet.PageSetup.PrintArea = "$B$2:" + oSheet.Cells(oRange.Row - 1, oRange.Column - 1).Address
                    
                    cCol = oSheet.Cells(1, oRange.Column).Address + ":" + oSheet.Cells(1, oSheet.Columns.Count).Address
                    cCol = VBA.Replace(VBA.Replace(cCol, "$1", ""), "$", "")
                    oSheet.Columns(cCol).Locked = False
                End If
                
                ' #sql_field:
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "ks_sql_field_") > 0 Then
                    cAddr = VBA.Mid(oSheet.Scripts(nCnt).ID, 1 + VBA.Len("ks_sql_field_"))
                    Set oRange = oSheet.Range(cAddr)
                    
                    ' #sql_field:<name>;<type>;<oper>;<val1>;<val2>
                    ' --
                    ' <name> - имя поля
                    ' <type> - тип поля: 
                    '     "STRING" - строка
                    '     , "DATE" -  дата
                    '     , "NUMBER" - число
                    '     , "LIST" - список (используется значение <val1> разделитель запятая пример: "1,2,3"
                    '                         , игнорируются <oper> и <val2>)
                    ' <oper> - оператор проверки данных:
                    '     "=" - равно (используется значение <val1>, игнорируется <val2>)
                    '     , "<>" - не равно (используется значение <val1>, игнорируется <val2>)
                    '     , ">" - больше (используется значение <val1>, игнорируется <val2>)
                    '     , "<" - меньше (используется значение <val1>, игнорируется <val2>)
                    '     , ">=" - больше или равно (используется значение <val1>, игнорируется <val2>)
                    '     , "<=" - меньше или равно (используется значение <val1>, игнорируется <val2>)
                    '     , "[]" - между (используются значения <val1> и <val2>)
                    '     , "][" - вне (используются значения <val1> и <val2>)
                    ' <val1> - начальное значение интервала
                    ' <val2> - конечное значение интервала
                    
                    сFieldName = VBA.Trim(GetStrParam(oSheet.Scripts(nCnt).ScriptText, 1, ";"))
                    сFieldType = VBA.UCase(VBA.Trim(GetStrParam(oSheet.Scripts(nCnt).ScriptText, 2, ";")))
                    сFieldOper = VBA.Trim(GetStrParam(oSheet.Scripts(nCnt).ScriptText, 3, ";"))
                    сFieldVal1 = VBA.Trim(GetStrParam(oSheet.Scripts(nCnt).ScriptText, 4, ";"))
                    сFieldVal2 = VBA.Trim(GetStrParam(oSheet.Scripts(nCnt).ScriptText, 5, ";"))
                    oSheet.Scripts(nCnt).ScriptText = сFieldName
                    
                    nTypeValue = -1
                    Select Case сFieldType
                    Case "STRING"
                        nTypeValue = xlValidateTextLength
                        сErrorMessage = "Длина текста"
                    Case "DATE"
                        nTypeValue = xlValidateDate
                        
                        сFieldVal1 = VBA.IIf(сFieldVal1 = "", "19000101", сFieldVal1)
                        сFieldVal1 = VBA.Val(VBA.Mid(сFieldVal1, 5, 2)) & "/" & VBA.Val(VBA.Right(сFieldVal1, 2)) & "/" & VBA.Val(VBA.Left(сFieldVal1, 4))
                        
                        сFieldVal2 = VBA.IIf(сFieldVal2 = "", "22000101", сFieldVal2)
                        сFieldVal2 = VBA.Val(VBA.Mid(сFieldVal2, 5, 2)) & "/" & VBA.Val(VBA.Right(сFieldVal2, 2)) & "/" & VBA.Val(VBA.Left(сFieldVal2, 4))
                        
                        сErrorMessage = "Дата"
                    Case "NUMBER"
                        nTypeValue = xlValidateDecimal
                        сErrorMessage = "Число"
                    Case "LIST"
                        nTypeValue = xlValidateList
                        сErrorMessage = "Значение принадлежит списку значений: " + сFieldVal1
                        сFieldOper = ""
                    End Select
                    
                    If сFieldType = "DATE" Then
                        сError1 = VBA.Format(сFieldVal1, "dd.mm.yyyy")
                        сError2 = VBA.Format(сFieldVal2, "dd.mm.yyyy")
                    Else
                        сError1 = сFieldVal1
                        сError2 = сFieldVal2
                    End If
                    
                    nOperValue = -1
                    Select Case сFieldOper
                    Case "="
                        nOperValue = xlEqual
                        сErrorMessage = сErrorMessage + " равно значению: " + сError1
                    Case "<>"
                        nOperValue = xlNotEqual
                        сErrorMessage = сErrorMessage + " не равно значению: " + сError1
                    Case ">"
                        nOperValue = xlGreater
                        сErrorMessage = сErrorMessage + " больше значения: " + сError1
                    Case "<"
                        nOperValue = xlLess
                        сErrorMessage = сErrorMessage + " меньше значения: " + сError1
                    Case ">="
                        nOperValue = xlGreaterEqual
                        сErrorMessage = сErrorMessage + " больше или равно значению: " + сError1
                    Case "<="
                        nOperValue = xlLessEqual
                        сErrorMessage = сErrorMessage + " меньше или равно значению: " + сError1
                    Case "[]"
                        nOperValue = xlBetween
                        сErrorMessage = сErrorMessage + " между значенями: " + сError1 + " .. "+ сError2
                    Case "]["
                        nOperValue = xlNotBetween
                        сErrorMessage = сErrorMessage + " вне интервала значений: " + сError1 + " .. "+ сError2
                    End Select
                    
                    If nTypeValue > 0 Then
                        With oRange.Validation
                            .Delete
                            If nOperValue > 0 Then
                                .Add Type:=nTypeValue, AlertStyle:=xlValidAlertStop, Operator:=nOperValue, Formula1:=сFieldVal1, Formula2:=сFieldVal2
                            Else
                                .Add Type:=nTypeValue, AlertStyle:=xlValidAlertStop, Formula1:=сFieldVal1, Formula2:=сFieldVal2
                            End If
                            .ErrorMessage = "Не выполняется ограничение: " + VBA.vbNewLine + сErrorMessage + "!"
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .ShowInput = False
                            .InputTitle = ""
                            .InputMessage = ""
                            .ShowError = True
                            .ErrorTitle = "Ошибка!"
                        End With
                    End If
                End If
                
                ' #edit_begin:
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "ks_edit_begin_") > 0 Then
                    cAddr = VBA.Mid(oSheet.Scripts(nCnt).ID, 1 + VBA.Len("ks_edit_begin_"))
                    nTagValue = VBA.Val(VBA.Trim(oSheet.Scripts(nCnt).ScriptText))
                    Set oRange = oSheet.Range(cAddr)
                    
                    For nRow = oRange.Row To oRange.Row + nTagValue - 1
                        With oSheet.Cells(nRow, oRange.Column - 1)
                            .Value = VBA.IIf(nRow = oRange.Row, "ДОБАВИТЬ", "УДАЛИТЬ")
                            .Borders(xlEdgeLeft).LineStyle = xlContinuous
                            .Borders(xlEdgeTop).LineStyle = xlContinuous
                            .Borders(xlEdgeBottom).LineStyle = xlContinuous
                            .Borders(xlEdgeRight).LineStyle = xlContinuous
                            ' .Borders(xlInsideVertical).LineStyle = xlContinuous
                            ' .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                            .Interior.ColorIndex = 6
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlTop
                        End With
                    Next nRow
                End If
            Next nCnt
        End If
    Next oSheet
    Application.Calculation = xlCalculationAutomatic
    Exit Sub

doError:
    Call ShowErrorEvent("InitSettings")
End Sub
' -------------------------------------------------------------------------------------------------------
Sub InitToolbar(ByVal cMode As String)
    Dim bFound As Boolean, oToolbar As Object
    
    On Error GoTo doError
    
    bFound = False
    For Each oToolbar In Application.CommandBars
        If oToolbar.Name = "CashPlanMenu" Then bFound = True
    Next
    If bFound Then Application.CommandBars("CashPlanMenu").Delete

    Set oToolbar = CommandBars.Add(Name:="CashPlanMenu", Position:=msoBarTop, Temporary:=True)
    With oToolbar.Controls.Add(Type:=msoControlButton)
        .FaceId = 342
        .Style = msoButtonIcon
        .Caption = "Сохранить данные отчета на сервере"
        .OnAction = "ReportSaveServer"
    End With

    With oToolbar.Controls.Add(Type:=msoControlButton)
        .BeginGroup = True
        .FaceId = 263
        .Style = msoButtonIcon
        .Caption = "Сохранить отчет в MS Excel файл(ы) на диске"
        .OnAction = "ReportSaveExcel"
    End With
    
    oToolbar.Enabled = True
    oToolbar.Visible = True
    Application.Calculation = xlCalculationAutomatic
    Application.ActiveWorkbook.Saved = True
    Application.ThisWorkbook.Saved = True
    Exit Sub

doError:
    Call ShowErrorEvent("InitToolbar")
End Sub
' -------------------------------------------------------------------------------------------------------
Sub InitToolbarRedo(ByVal cMode As String)
    Call InitToolbar(cMode)
End Sub
' -------------------------------------------------------------------------------------------------------
Sub PutInfo(Optional ByVal cInfo As String = "", Optional ByVal cFileTxt As String = "", Optional ByVal cFileHtm As String = "" _
        , Optional ByVal nMode As Integer = 1, Optional ByVal nLevel As Integer = 0, Optional ByVal bStatus As Boolean = False _
        , Optional ByVal cHtmSpanStyle As String = "", Optional ByVal nModeTxt As Long = 0, Optional ByVal bBorders As Boolean = False)
    Dim cSpace As String, nCnt As Long, cOutInfo As String
    
    On Error GoTo doError
    
    If (nMode And 2) = 2 Then
        cInfo = VBA.Trim(cInfo + " Время выполнения: " + VBA.Format(VBA.Time - tPhaseBegin, "hh:mm:ss"))
        tPhaseBegin = VBA.Time
    End If
    
    If cFileTxt <> "" Then
        If nMode = 0 Then
            Open cFileTxt For Output As #1
        Else
            Open cFileTxt For Append As #1
        End If
        
        If nModeTxt = 0 Then
            cOutInfo = cInfo
            If nLevel > 0 Then
                cOutInfo = VBA.IIf(nLevel = 1, VBA.vbNewLine, "") + VBA.String((nLevel - 1) * 4, " ") _
                    + VBA.Replace(cInfo, VBA.Chr(10), VBA.Chr(10) + VBA.String((nLevel - 1) * 4, " "))
            End If
        Else
            cSpace = ""
            For nCnt = 1 To (nLevel - 1) * 4
                cSpace = cSpace + "&nbsp;"
            Next nCnt
            
            cOutInfo = cInfo
            If nLevel > 0 And Not bBorders Then
                If nLevel = 1 Then
                    cOutInfo = "<H1>" + cSpace + VBA.Replace(cInfo, VBA.Chr(10), "<BR>" + cSpace) + "</H1>"
                Else
                    cOutInfo = cSpace + VBA.Replace(cInfo, VBA.Chr(10), "<BR>" + cSpace) + "<BR>"
                End If
            End If
            
            If cHtmSpanStyle <> "" Then
                cOutInfo = "<span style=""" + cHtmSpanStyle + """>" + cOutInfo + "</span>"
            End If
            
            If bBorders Then
                cOutInfo = "<TABLE STYLE=""FONT-SIZE: X-SMALL""><TR><TD>" + cSpace _
                    + "</TD><TD><TABLE STYLE=""FONT-SIZE: X-SMALL; BORDER: 1 GRAY SOLID""><TR><TD>" + VBA.Replace(cOutInfo, VBA.Chr(10), "<BR>") _
                    + "</TD></TR></TABLE></TD></TR></TABLE>"
            End If
        End If
        
        Print #1, cOutInfo
        Close #1
    End If
    
    If cFileHtm <> "" And (nModeTxt <> 4 Or (nMode And 4) = 4 Or cInfo = "") Then
        If nMode = 0 Then
            Open cFileHtm For Output As #1
        Else
            Open cFileHtm For Append As #1
        End If
        
        cSpace = ""
        For nCnt = 1 To (nLevel - 1) * 4
            cSpace = cSpace + "&nbsp;"
        Next nCnt
        
        cOutInfo = cInfo
        If nLevel > 0 And Not bBorders Then
            If nLevel = 1 Then
                cOutInfo = "<H1>" + cSpace + VBA.Replace(cInfo, VBA.Chr(10), "<BR>" + cSpace) + "</H1>"
            Else
                cOutInfo = cSpace + VBA.Replace(cInfo, VBA.Chr(10), "<BR>" + cSpace) + "<BR>"
            End If
        End If
        
        If cHtmSpanStyle <> "" Then
            cOutInfo = "<span style=""" + cHtmSpanStyle + """>" + cOutInfo + "</span>"
        End If
        
        If bBorders Then
            cOutInfo = "<TABLE STYLE=""FONT-SIZE: X-SMALL""><TR><TD>" + cSpace _
                + "</TD><TD><TABLE STYLE=""FONT-SIZE: X-SMALL; BORDER: 1 GRAY SOLID""><TR><TD>" + VBA.Replace(cOutInfo, VBA.Chr(10), "<BR>") _
                + "</TD></TR></TABLE></TD></TR></TABLE>"
        End If
        
        Print #1, cOutInfo
        Close #1
    End If
    
    If bStatus Then
        Application.StatusBar = cInfo
    End If
    Exit Sub

doError:
    Call ShowErrorEvent("PutInfo")
End Sub
' -------------------------------------------------------------------------------------------------------
Function ReplaceSheetVariable(ByVal oSheet As Worksheet, ByVal cText As String, ByVal cAddr As String) As String
    Dim bLoop As Boolean, nPos1 As Long, nPos2 As Long, cName As String, nIndex As Long, cCurrAddr As String _
        , cReplace As String, cDecimal As String
    
    On Error GoTo doError
    cDecimal = GetLocalInfo(LOCALE_DECIMAL)
    
    ' глобальные
    bLoop = True
    While VBA.InStr(cText, "[[[") > 0 And bLoop
        nPos1 = VBA.InStr(cText, "[[[")
        If VBA.InStr(nPos1, cText, "]]]") > 0 Then
            nPos2 = VBA.InStr(nPos1, cText, "]]]")
            cName = VBA.Mid(cText, nPos1, nPos2 - nPos1 + 3)
            cReplace = ""
            
            For nIndex = 1 To oSheet.Scripts.Count
                cCurrAddr = ""
                ' по новой схеме
                If VBA.InStr(oSheet.Scripts(nIndex).ID, "ks_sql_field_") > 0 _
                    And VBA.UCase("[[[" + oSheet.Scripts(nIndex).ScriptText + "]]]") = VBA.UCase(cName) _
                Then
                    cCurrAddr = VBA.Trim(VBA.Mid(oSheet.Scripts(nIndex).ID, 1 + VBA.Len("ks_sql_field_")))
                End If
                ' поддержка старой схемы
                If VBA.InStr(oSheet.Scripts(nIndex).ID, "field_term_") > 0 _
                    And VBA.UCase(oSheet.Scripts(nIndex).ScriptText) = VBA.UCase(cName) _
                Then
                    cCurrAddr = VBA.Trim(VBA.Mid(oSheet.Scripts(nIndex).ID, 1 + VBA.Len("field_term_")))
                End If
                
                If cCurrAddr <> "" Then
                    If VBA.IsDate(oSheet.Range(cCurrAddr).Value) And oSheet.Range(cCurrAddr).NumberFormat = "dd.mm.yyyy" Then
                        cReplace = VBA.Format(oSheet.Range(cCurrAddr).Value, "yyyymmdd")
                    Else
                        cReplace = "" & oSheet.Range(cCurrAddr).Value & ""
                    End If
                    
                    If VBA.IsNumeric(oSheet.Range(cCurrAddr).Value) Then
                        cReplace = VBA.Replace(cReplace, cDecimal, ".")
                    End If
                    
                    Exit For
                End If
            Next nIndex
            
            cReplace = VBA.IIf(cReplace = "", "null", cReplace)
            cText = VBA.Replace(cText, cName, cReplace)
        Else
            bLoop = False
        End If
    Wend
    
    ' локальные
    bLoop = True
    While VBA.InStr(cText, "[[") > 0 And bLoop
        nPos1 = VBA.InStr(cText, "[[")
        If VBA.InStr(nPos1, cText, "]]") > 0 Then
            nPos2 = VBA.InStr(nPos1, cText, "]]")
            cName = VBA.Mid(cText, nPos1, nPos2 - nPos1 + 2)
            cReplace = ""
            
            For nIndex = 1 To oSheet.Scripts.Count
                cCurrAddr = ""
                ' по новой схеме
                If VBA.InStr(oSheet.Scripts(nIndex).ID, "ks_sql_field_") > 0 _
                    And VBA.UCase("[[" + oSheet.Scripts(nIndex).ScriptText + "]]") = VBA.UCase(cName) _
                Then
                    cCurrAddr = VBA.Trim(VBA.Mid(oSheet.Scripts(nIndex).ID, 1 + VBA.Len("ks_sql_field_")))
                End If
                ' поддержка старой схемы
                If VBA.InStr(oSheet.Scripts(nIndex).ID, "field_term_") > 0 _
                    And VBA.UCase(oSheet.Scripts(nIndex).ScriptText) = VBA.UCase(cName) _
                Then
                    cCurrAddr = VBA.Trim(VBA.Mid(oSheet.Scripts(nIndex).ID, 1 + VBA.Len("field_term_")))
                End If
                
                If cCurrAddr <> "" Then
                    If oSheet.Range(cCurrAddr).Cells(1, 1).Row = oSheet.Range(cAddr).Cells(1, 1).Row Then
                        If VBA.IsDate(oSheet.Range(cCurrAddr).Value) And oSheet.Range(cCurrAddr).NumberFormat = "dd.mm.yyyy" Then
                            cReplace = VBA.Format(oSheet.Range(cCurrAddr).Value, "yyyymmdd")
                        Else
                            cReplace = "" & oSheet.Range(cCurrAddr).Value & ""
                        End If
                        
                        If VBA.IsNumeric(oSheet.Range(cCurrAddr).Value) Then
                            cReplace = VBA.Replace(cReplace, cDecimal, ".")
                        End If
                        
                        Exit For
                    End If
                End If
            Next nIndex
            
            cReplace = VBA.IIf(cReplace = "", "null", cReplace)
            cText = VBA.Replace(cText, cName, cReplace)
        Else
            bLoop = False
        End If
    Wend
    
    ReplaceSheetVariable = ReplaceStr(cText, "'null'", "''")
    Exit Function

doError:
    ReplaceSheetVariable = ""
    Call ShowErrorEvent("ReplaceSheetVariable")
End Function
' -------------------------------------------------------------------------------------------------------
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
    
    On Error GoTo doError
    
    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
    Exit Function

doError:
    ReplaceStr = ""
    Call ShowErrorEvent("ReplaceStr")
End Function
' -------------------------------------------------------------------------------------------------------
Sub ReportSaveExcel()
    Dim aFile() As String, aSheet() As String, aBook() As String, aModule() As String _
        , oCurrApp As Application, cSavePath As String, cFolder As String, i As Long _
        , j As Long, oCurrBook As Workbook, oSaveBook As Workbook, oCurrSheet As Worksheet _
        , oSaveSheet As Worksheet, nIndex As Long, nVisible As Long, nSheet As Long _
        , nFile As Long, cFile As String, bCopyModule As Boolean, bModule As Boolean _
        , nModule As Long, bFile As Boolean, bSaveBook As Boolean, cDecimal As String _
        , oSrcSheet As Worksheet, oDestSheet As Worksheet, nDel As Long, nStart As Long _
        , nEnd As Long, nAnswer As Long, oFolder, cPostfix As String, cDepAddr As String _
        , aSave() As String, nSave As Long, cAnalitAddr As String, cDep As String _
        , cCorr As String, cReplaceList As String
    
    ' Спецкодировка и ее расшифровка тегов для формирования выходного имени файла
    ' {corr} или {корр} - наименование получателя
    ' {sheet} или {лист} - имя листа Excel
    ' {dep} или {квср} - КВСР
    ' {dd} или {дд} или {день} - день
    ' {mm} или {мм} или {месяц} - месяц
    ' {yyyy} или {гггг} или {год} - год
    ' Примеры:
    ' заявка_{dep}_{mm}_{yyyy}_1.xls
    ' {sheet}-{dd}-{mm}-{yyyy}.xls
    
    On Error GoTo doError
    cDecimal = GetLocalInfo(LOCALE_DECIMAL)
    
    cSavePath = ""
    Set oCurrApp = Application
    nAnswer = VBA.MsgBox("Разбить отчет MS Excel по корреспондентам (ведомствам, администраторам)?" _
                , VBA.vbYesNo + VBA.vbInformation, "Внимание")
    
    cPostfix = ""
    If nAnswer = 6 Then
        cPostfix = VBA.InputBox( _
            "Введите добавочный шаблон к имени выходного файла. ВНИМАНИЕ: максимальная длина имени файла 100 символов!" _
            + VBA.vbNewLine + VBA.vbNewLine + "Возможные теги:" _
            + VBA.vbNewLine + "  {corr} или {корр} - наименование получателя" _
            + VBA.vbNewLine + "  {dep} или {квср} - КВСР" _
            + VBA.vbNewLine + "  {sheet} или {лист} - имя листа Excel" _
            + VBA.vbNewLine + "  {dd} или {дд} или {день} - день" _
            + VBA.vbNewLine + "  {mm} или {мм} или {месяц} - месяц" _
            + VBA.vbNewLine + "  {yyyy} или {гггг} или {год} - год" _
            + VBA.vbNewLine +  VBA.vbNewLine + "Примеры:" _
            + VBA.vbNewLine + "  заявка_{dep}_{mm}_{yyyy}_1" _
            + VBA.vbNewLine + "  {корр}-{дд}-{мм}-{гггг}" _
            , "Внимание", cPostfix)
    End If
    
    oCurrApp.ScreenUpdating = False
    oCurrApp.Calculation = xlCalculationManual
    oCurrApp.DisplayAlerts = False
    
    nSheet = 0
    nFile = 0
    nSave = 0
    bCopyModule = False
    
    ReDim Preserve aFile(nFile)
    ReDim Preserve aSave(nSave)
    ReDim Preserve aSheet(nSheet)
    ReDim Preserve aBook(nSheet)
    
    Application.StatusBar = "Анализ сохраняемых данных..."
    For Each oCurrBook In oCurrApp.Workbooks
        bModule = False
        For nModule = 1 To oCurrBook.VBProject.VBComponents.Count
            bModule = bModule Or (oCurrBook.VBProject.VBComponents(nModule).Name = "CashPlanWork")
        Next nModule
        
        If bModule Then
            If Not bCopyModule Then
                If VBA.Dir(oCurrApp.DefaultFilePath + "\*.bas") <> "" Then VBA.Kill (oCurrApp.DefaultFilePath + "\*.bas")
                nModule = 0
                ReDim Preserve aModule(nModule)
                For nIndex = 1 To oCurrBook.VBProject.VBComponents.Count
                    If oCurrBook.VBProject.VBComponents(nIndex).Type = 1 And oCurrBook.VBProject.VBComponents(nIndex).Name = "CashPlanWork" Then
                        nModule = nModule + 1
                        ReDim Preserve aModule(nModule)
                        aModule(nModule) = oCurrApp.DefaultFilePath + "\" + oCurrBook.VBProject.VBComponents(nIndex).Name + ".bas"
                        oCurrBook.VBProject.VBComponents(nIndex).Export (aModule(nModule))
                    End If
                Next nIndex
                bCopyModule = True
            End If
            
            For Each oCurrSheet In oCurrBook.Sheets
                Application.StatusBar = "Анализ сохраняемых данных. Книга: " + oCurrBook.Name + ". Лист: " + oCurrSheet.Name
                If oCurrSheet.Visible = -1 And oCurrSheet.Scripts.Count > 0 Then
                    If nAnswer = 6 Then
                        cFile = oCurrSheet.Name
                        If VBA.InStr(oCurrSheet.Name, "ЛИСТ") > 0 Then
                            cFile = VBA.Left(cFile, VBA.InStr(oCurrSheet.Name, "ЛИСТ") - 1)
                            cFile = VBA.IIf(VBA.Right(cFile, 1) = ".", VBA.Left(cFile, VBA.Len(cFile) - 1), cFile)
                        End If
                    Else
                        cFile = oCurrBook.Name
                        cFile = VBA.IIf(VBA.InStr(cFile, ".") > 0, VBA.Left(cFile, VBA.InStr(cFile, ".") - 1), cFile)
                    End If
                    
                    If nFile > 0 Then
                        bFile = False
                        For nIndex = 1 To nFile
                            bFile = bFile Or (aFile(nIndex) = cFile)
                        Next nIndex
                        
                        If Not bFile Then
                            nFile = nFile + 1
                            ReDim Preserve aFile(nFile)
                            aFile(nFile) = cFile
                        End If
                    Else
                        nFile = nFile + 1
                        ReDim Preserve aFile(nFile)
                        aFile(nFile) = cFile
                    End If
                    
                    If nSave < nFile Then
                        nSave = nSave + 1
                        ReDim Preserve aSave(nSave)
                        
                        If VBA.InStr(cPostfix, "{-sheet}") > 0 Or VBA.InStr(cPostfix, "{sheet-}") > 0 Then
                            cFile = VBA.Trim(VBA.Replace(VBA.Replace(cPostfix, "{-sheet}", ""), "{sheet-}", "") )
                        Else
                            cFile = VBA.Trim("{sheet}" + VBA.IIf(cPostfix <> "", ".", "") + cPostfix)
                        End If
                        
                        cFile = VBA.Replace(cFile, "{dd}", VBA.Trim(VBA.Format(VBA.Day(VBA.Date()), "00")))
                        cFile = VBA.Replace(cFile, "{дд}", VBA.Trim(VBA.Format(VBA.Day(VBA.Date()), "00")))
                        cFile = VBA.Replace(cFile, "{день}", VBA.Trim(VBA.Format(VBA.Day(VBA.Date()), "00")))
                        
                        cFile = VBA.Replace(cFile, "{mm}", VBA.Trim(VBA.Format(VBA.Month(VBA.Date()), "00")))
                        cFile = VBA.Replace(cFile, "{мм}", VBA.Trim(VBA.Format(VBA.Month(VBA.Date()), "00")))
                        cFile = VBA.Replace(cFile, "{месяц}", VBA.Trim(VBA.Format(VBA.Month(VBA.Date()), "00")))
                        
                        cFile = VBA.Replace(cFile, "{yyyy}", VBA.Trim(VBA.Format(VBA.Year(VBA.Date()), "0000")))
                        cFile = VBA.Replace(cFile, "{гггг}", VBA.Trim(VBA.Format(VBA.Year(VBA.Date()), "0000")))
                        cFile = VBA.Replace(cFile, "{год}", VBA.Trim(VBA.Format(VBA.Year(VBA.Date()), "0000")))
                        
                        cDepAddr = ""
                        For nIndex = 1 To oCurrSheet.Scripts.Count
                            If VBA.LCase(VBA.Trim("[[" + oCurrSheet.Scripts(nIndex).ScriptText + "]]")) = "[[dep]]" _
                                And VBA.InStr(1, oCurrSheet.Scripts(nIndex).ID, "ks_sql_field_") > 0 _
                            Then
                                cDepAddr = VBA.Trim(VBA.Replace(oCurrSheet.Scripts(nIndex).ID, "ks_sql_field_", ""))
                                Exit For
                            End If
                        Next nIndex
                        
                        cDep = ""
                        If cDepAddr <> "" Then
                            cDep = VBA.Trim(oCurrSheet.Cells( _
                                oCurrSheet.Range(cDepAddr).Cells(1, 1).Row - 1, _
                                oCurrSheet.Range(cDepAddr).Cells(1, 1).Column).Text)
                        End If
                        
                        If cDep = "" Then
                            cDep = VBA.IIf(VBA.InStr(1, aFile(nFile), ".") > 0, _
                                VBA.Mid(aFile(nFile), VBA.InStr(1, aFile(nFile), ".") + 1, 1000), _
                                aFile(nFile))
                        End If
                        
                        cAnalitAddr = ""
                        For nIndex = 1 To oCurrSheet.Scripts.Count
                            If VBA.LCase(VBA.Trim("[[" + oCurrSheet.Scripts(nIndex).ScriptText + "]]")) = "[[analit]]" _
                                And VBA.InStr(1, oCurrSheet.Scripts(nIndex).ID, "ks_sql_field_") > 0 _
                            Then
                                cAnalitAddr = VBA.Trim(VBA.Replace(oCurrSheet.Scripts(nIndex).ID, "ks_sql_field_", ""))
                                Exit For
                            End If
                        Next nIndex
                        
                        cCorr = ""
                        If cAnalitAddr <> "" Then
                            nIndex = oCurrSheet.Range(cAnalitAddr).Cells(1, 1).Row
                            While oCurrSheet.Cells(nIndex, oCurrSheet.Range(cAnalitAddr).Cells(1, 1).Column - 1).Value <> ""
                                Select Case _
                                    VBA.Trim(oCurrSheet.Cells(nIndex, oCurrSheet.Range(cAnalitAddr).Cells(1, 1).Column - 1).Value)
                                Case "Администратор:", "Корреспондент:", "Ведомство:", "Получатель:"
                                    cCorr = VBA.Trim(oCurrSheet.Cells(nIndex, oCurrSheet.Range(cAnalitAddr).Cells(1, 1).Column).Value)
                                End Select
                                
                                nIndex = nIndex - 1
                            Wend
                            
                            If cCorr <> "" Then
                                cReplaceList = "`~!@#$%^&*()-=+\|:;""',.<>/?[]{}"
                                For nIndex = 1 To VBA.Len(cReplaceList)
                                    cCorr = VBA.Replace(cCorr, VBA.Mid(cReplaceList, nIndex, 1), "")
                                Next nIndex
                                
                                For nIndex = 1 To 31
                                    cCorr = VBA.Replace(cCorr, VBA.Chr(nIndex), "")
                                Next nIndex
                                
                                cCorr = VBA.Trim(cCorr)
                            End If
                        End If
                        
                        If VBA.InStr(1, cFile, "{dep}") > 0 Or VBA.InStr(1, cFile, "{квср}") > 0 _
                            Or VBA.InStr(1, cFile, "{corr}") > 0 Or VBA.InStr(1, cFile, "{корр}") > 0 _
                            Or VBA.InStr(1, cFile, "{sheet}") > 0 Or VBA.InStr(1, cFile, "{лист}") > 0 _
                        Then
                            cFile = VBA.Replace(cFile, "{dep}", cDep)
                            cFile = VBA.Replace(cFile, "{квср}", cDep)
                            
                            cFile = VBA.Replace(cFile, "{sheet}", aFile(nFile))
                            cFile = VBA.Replace(cFile, "{лист}", aFile(nFile))
                            
                            cFile = VBA.Replace(cFile, "{corr}", VBA.IIf(VBA.Len(cFile) + 4 - 6 < 100, VBA.Left(cCorr, 100 - VBA.Len(cFile) - 4 + 6), ""))
                            cFile = VBA.Replace(cFile, "{корр}", VBA.IIf(VBA.Len(cFile) + 4 - 6 < 100, VBA.Left(cCorr, 100 - VBA.Len(cFile) - 4 + 6), ""))
                        Else
                            cFile = aFile(nFile)
                        End If
                        
                        aSave(nSave) = VBA.Left(cFile, 100 - 4)
                    End If
                    
                    nSheet = nSheet + 1
                    ReDim Preserve aSheet(nSheet)
                    aSheet(nSheet) = oCurrSheet.Name
                    ReDim Preserve aBook(nSheet)
                    aBook(nSheet) = oCurrBook.Name
                End If
            Next oCurrSheet
        End If
        
        oCurrBook.Saved = True
    Next oCurrBook
    
    If nFile > 0 Then
        cFile = ""
        For i = 1 To nFile
            If VBA.Len(cFile + VBA.vbNewLine + "  " + aSave(i) + ".xls") > 900 Then
                cFile = cFile + VBA.vbNewLine + "  ..." + VBA.vbNewLine + "Итого: " + VBA.Trim(VBA.Format(nFile, "0")) + " файлов."
                Exit For
            Else
                cFile = cFile + VBA.vbNewLine + "  " + aSave(i) + ".xls"
            End If
        Next i
        
        If VBA.MsgBox("Список сохраняемых файлов:" _
            + cFile + VBA.vbNewLine + VBA.vbNewLine + "Продолжить?" _
            , VBA.vbYesNo + VBA.vbInformation, "Внимание") <> 6 _
        Then
            GoTo ExitSub
        End If
    Else
        Call VBA.MsgBox("Сохранение невозможно. Отсутствуют необходимые данные и структуры." _
            , VBA.vbOKOnly + VBA.vbExclamation, "Внимание")
        GoTo ExitSub
    End If
    
    Application.StatusBar = "Сохранение данных на диск..."
    For i = 1 To nFile
        Set oSaveBook = oCurrApp.Workbooks.Add
        bSaveBook = False
        
        For j = 1 To nSheet
            If (nAnswer = 6 And VBA.InStr(aSheet(j), aFile(i)) > 0) _
                    Or (nAnswer <> 6 And VBA.InStr(aBook(j), aFile(i)) > 0) Then
                bSaveBook = True
                Set oSrcSheet = oCurrApp.Workbooks(aBook(j)).Worksheets(aSheet(j))
                oSrcSheet.Copy After:=oSaveBook.Sheets(1)
                Set oDestSheet = Application.ActiveSheet
                nStart = oSrcSheet.Scripts.Count
                nEnd = oDestSheet.Scripts.Count
                If nStart < nEnd Then
                    For nDel = nEnd To nStart + 1 Step -1
                        Call oDestSheet.Scripts(nDel).Delete
                    Next nDel
                End If
            End If
        Next j
        
        If bSaveBook Then
            If bCopyModule Then
                For nModule = 1 To UBound(aModule)
                    oSaveBook.VBProject.VBComponents.Import (aModule(nModule))
                Next nModule
            End If
            
            For Each oSaveSheet In oSaveBook.Sheets
                If oSaveSheet.ProtectContents = False Then
                    oSaveSheet.Delete
                End If
            Next oSaveSheet
        
            If cSavePath = "" Then
                oFolder = oCurrApp.GetSaveAsFilename( _
                    InitialFileName:="укажите только путь для сохранения", _
                    FileFilter:="Книга Excel 97-2003 (*.xls),*.xls", _
                    Title:="Укажите путь для сохранения ...")
                
                If Not oFolder <> False Then
                    GoTo ExitSub
                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 ExitSub
                End If
                
                cSavePath = VBA.Left(oFolder, nIndex)
                cFolder = cSavePath
                cSavePath = GetShortPath(cSavePath)
                If VBA.Dir(cSavePath, VBA.vbDirectory) = "" Then Call VBA.MkDir(cSavePath)
            End If
            
            oCurrApp.Calculation = xlCalculationAutomatic
            If VBA.Val(oCurrApp.Version) >= 12 Then
                oSaveBook.SaveAs Filename:=cSavePath + aSave(i) + ".xls", FileFormat:=56 'xlExcel8
            Else
                oSaveBook.SaveAs Filename:=cSavePath + aSave(i) + ".xls"
            End If
            oCurrApp.Calculation = xlCalculationManual
        End If
        
        oSaveBook.Saved = True
        oSaveBook.Close SaveChanges:=False
        Application.StatusBar = "Сохранение данных на диск: " + VBA.Replace(VBA.Format(i / nFile, "0%"), cDecimal, ".")
    Next i
    
    For nModule = 1 To UBound(aModule)
        If VBA.Dir(aModule(nModule)) <> "" Then VBA.Kill (aModule(nModule))
    Next nModule
    
    oCurrApp.StatusBar = False
    oCurrApp.DisplayAlerts = True
    oCurrApp.ScreenUpdating = True
    oCurrApp.Calculation = xlCalculationAutomatic
    
    Call VBA.MsgBox("Сохранение произведено в каталог:" _
                    + VBA.vbNewLine + cFolder _
                    , VBA.vbOKOnly + VBA.vbInformation, "Внимание")
    Exit Sub
    
doError:
    Call ShowErrorEvent("ReportSaveExcel")
    
ExitSub:
    If Not oSaveBook Is Nothing Then
        oSaveBook.Saved = True
        oSaveBook.Close SaveChanges:=False
    End If
    
    oCurrApp.StatusBar = False
    oCurrApp.DisplayAlerts = True
    oCurrApp.ScreenUpdating = True
    oCurrApp.Calculation = xlCalculationAutomatic
End Sub
' -------------------------------------------------------------------------------------------------------
Sub ReportSaveServer(Optional ByVal nModeSave As Long = 0, Optional ByRef nErrorSave As Long = 0 _
        , Optional ByRef cUserLog As String = "", Optional ByRef cSysLog As String = "")
    Dim oSheet As Worksheet, nIndex As Integer, cText As String, cText1 As String _
        , cSql As String, cLogSql As String, cReplace As String, cReplaceText As String _
        , cDecimal As String, nCnt As Integer, cAddr As String, oBook As Workbook _
        , cProperty As String, cError As String _
        , WshShell, RetVal, cCmd As String, nVal As Long, bErrCtl As Boolean _
        , cLogCtl As String, oRecordSet, cUser As String, nType As Long _
        , cSrv As String, cDb As String, cLogCtlEnd As String, nCounter As Long _
        , cObjCode As String, cFullHtml As String, cHtml As String, cHeader As String _
        , cFooter As String, nResult As Long, bXMLHeader As Boolean, bXMLColumn As Boolean _
        , nFields As Long, nErrorControl As Long, bRecordSetNext As Boolean, cParameters As String _
        , nHeaderResult As Long, bExistsXMLColumn As Boolean, oRecordSetDesc _
        , cHtmlAdd As String, cXmlDesc As String, cXmlData As String, cXsltDesc As String _
        , cXmlFull As String, cXsltFull As String, cGrpFld As String, cGrpDesc As String _
        , cTmpFld As String, cTmpDesc As String, nFldCnt As Long, cTmp As String, cVal As String _
        , cDateFld As String, aGrpFld() As String, oXmlData, oNodeList, oNodeData, oNodeRow _
        , cAttr As String, cXmlVersion As String, nResultControl As Long, bResultControl As Boolean _
        , cEodNastr As String, nEodNastr As Long, aNastr() As String, bUseZero As Boolean _
        , cPcVersion As String, aObjCode() As String, aEodNastr() As String _
        , bFoundObjCode As Boolean, tSheetBegin, tBookBegin, cTabName As String, nErr As Long
    
    ' nErrorSave
    ' 1 - ни один контроль не сработал, данные сохранились - тогда как сейчас есть: данные успешно обработаны
    ' 2 - сработал информационный контроль - имеются не пройденные информационные контроли, данные сохранены
    ' 3 - сработал блокирующий контроль - имеются не пройденные блокирующие контроли, сохранение невозможно
    ' 4 - ошибки при приеме (не связанные с ЦК) - как сейчас - обнаружены ошибки при приеме
    
    tPhaseBegin = VBA.Time
    tBookBegin = tPhaseBegin
    
    On Error GoTo ErrMain
    cDecimal = GetLocalInfo(LOCALE_DECIMAL)
    Set oBook = Application.ActiveWorkbook
    Set WshShell = CreateObject("WScript.Shell")

    nErrorSave = 1
    nErrorControl = 1
    
    cLogCtl = Application.DefaultFilePath + "\save_ctl.htm"
    cUserLog = cLogCtl
    cLogSql = Application.DefaultFilePath + "\save_srv.txt"
    cSysLog = cLogSql
    
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, cInfo:="", nMode:=0)
    If nModeSave = 0 Then
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, _
            cInfo:="Системный протокол приема от: " + VBA.Format(VBA.Date, "dd.mm.yy") + ", время: " + VBA.Format(tBookBegin, "hh:mm:ss"))
    End If
    
    cXmlVersion = ""
    Set oXmlData = XmlCreateDomDocument(cXmlVersion)
    Set oXmlData = Nothing

    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=1, cInfo:="Информация о клиенте")
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Версия Excel: " + GetExcelVersion)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Книга Excel: " + oBook.Name)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Версия ADO: " + VBA.Trim(VBA.str(GetADOVersion())))
    If GetADOVersion() < 2.7 Then
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Внимание! Необходимо проинсталлировать MDAC версии 2.7 или выше!")
        GoTo ErrMain
    End If
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Версия MSXML: " + VBA.IIf(cXmlVersion = "", "неустановленна", cXmlVersion))
    If cXmlVersion = "" Then
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Внимание! Необходимо проинсталлировать MSXML версии 3.0, 4.0 или 6.0!")
        GoTo ErrMain
    End If
    
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=1, cInfo:="Подключение к базе данных")
    cError = ServerConnectOpen(oBook, cSrv, cDb, cUser)
    If cError <> "" Then
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:=cError)
        GoTo ErrMain
    Else
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Сервер: " + cSrv)
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="База данных: " + cDb)
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Пользователь: " + cUser)
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Успешно!")
    End If
    
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=1, cInfo:="Получение информации о комплексе:")
    cSql = "select top 1 [PcVersion]='ПК ""'+dbo.get_val('project','title',0)+'"" вер. '+rtrim(ltrim(code))+case when dbo.get_val('project','build_number',0) is null then '' else ' (сборка '+isnull(dbo.get_val('project','build_number',0),'')+')' end from s_note where link = (select max(link) from s_note where object = dbo.obj_id('project'))"
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:=cSql, bBorders:=True)
    
    Set oRecordSet = CreateObject("ADODB.RecordSet")
    oRecordSet.Open cSql, oConnection, 2, 1, 1
    
    cPcVersion = ""
    If Not oRecordSet Is Nothing Then
        If oRecordSet.State = 1 Then
            oRecordSet.MoveFirst
            If Not oRecordSet.EOF Then
                cPcVersion = oRecordSet.Fields("PcVersion").Value
            End If
        End If
    End If
    
    If Not oRecordSet Is Nothing Then
        If oRecordSet.State = 1 Then oRecordSet.Close
    End If
    Set oRecordSet = Nothing
    
    If cPcVersion <> "" Then
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Успешно!")
    Else
        cPcVersion = "Неизвестно."
    End If
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=1, cInfo:="Информация о комплексе:")
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:=cPcVersion)
    
    If nModeSave = 0 Then
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=1, cInfo:="Подготовка протокола контроля: " + cLogCtl)
        cSql = "execute dbo.GetHTMLTemplate @cRepHeader = '<H1>Протокол приема.</H1>', @cRepFooter = '', @cParameters = ''"
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:=cSql, bBorders:=True)
        
        Set oRecordSet = CreateObject("ADODB.RecordSet")
        oRecordSet.Open cSql, oConnection, 2, 1, 1
        
        cLogCtlEnd = ""
        If Not oRecordSet Is Nothing Then
            If oRecordSet.State = 1 Then
                oRecordSet.MoveFirst
                If Not oRecordSet.EOF Then
                    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, cInfo:=oRecordSet.Fields("HTMLHeader").Value)
                    cLogCtlEnd = oRecordSet.Fields("HTMLFooter").Value
                End If
            End If
        End If
        
        If Not oRecordSet Is Nothing Then
            If oRecordSet.State = 1 Then oRecordSet.Close
        End If
        Set oRecordSet = Nothing
        
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Успешно!")
    End If
    
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Информация о клиенте")
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="Версия Excel: " + GetExcelVersion)
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="Книга Excel: " + oBook.Name)
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="Версия ADO: " + VBA.Trim(VBA.str(GetADOVersion())))
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="Версия MSXML: " + cXmlVersion)
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Информация о сервере")
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="Сервер: " + cSrv)
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="База данных: " + cDb)
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="Пользователь: " + cUser)
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Информация о комплексе:")
    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:=cPcVersion)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Итоги предварительных действий", nMode:=1 + 4)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="", nMode:=1 + 2 + 4)
    
    On Error GoTo 0
    On Error GoTo ErrSheet
    For Each oSheet In oBook.Sheets
        tSheetBegin = tPhaseBegin
        
        cObjCode = ScriptGet(oSheet, "object_code")
        If cObjCode <> "" Then
            bFoundObjCode = False
            If CheckArray(aObjCode) Then
                For nCnt = 0 To UBound(aObjCode, 1)
                    If aObjCode(nCnt) = cObjCode Then
                        bFoundObjCode = True
                        Exit For
                    End If
                Next nCnt
            End If
            
            If Not bFoundObjCode Then
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Настройки контроля и сохранения:")
                
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, cInfo:="Получение настроек:")
                Select Case VBA.Trim(cObjCode)
                    Case "DOCUMENTS_ZAYAVKA_BUD"
                        cSql = "select [EodNastr] = isnull(dbo.get_val('PROTOCOLS_EOD_CP_ZB_XLS_IN', 'NASTR_CTRL_FINANS', 0), '')"
                    Case "DOCUMENTS_CASH_PLAN_EXPEND"
                        cSql = "select [EodNastr] = isnull(dbo.get_val('PROTOCOLS_EOD_CP_EXP_XLS_IN', 'NASTR_CTRL_FINANS', 0), '')"
                    Case "DOCUMENTS_CASH_PLAN_INCOME"
                        cSql = "select [EodNastr] = isnull(dbo.get_val('PROTOCOLS_EOD_CP_INC_XLS_IN', 'NASTR_CTRL_FINANS', 0), '')"
                    Case "DOCUMENTS_0504817"
                        cSql = "select [EodNastr] = isnull(dbo.get_val('PROTOCOLS_EOD_0504817_XLS_IN', 'NASTR_CTRL_FINANS', 0), '')"
                    Case Else
                        cSql = ""
                End Select
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:=cSql, bBorders:=True)
                
                cEodNastr = ""
                If cSql <> "" Then
                    Set oRecordSet = CreateObject("ADODB.RecordSet")
                    oRecordSet.Open cSql, oConnection, 2, 1, 1
                    
                    If Not oRecordSet Is Nothing Then
                        If oRecordSet.State = 1 Then
                            oRecordSet.MoveFirst
                            If Not oRecordSet.EOF Then
                                cEodNastr = oRecordSet.Fields("EodNastr").Value
                            End If
                        End If
                    End If
                    
                    If Not oRecordSet Is Nothing Then
                        If oRecordSet.State = 1 Then oRecordSet.Close
                    End If
                    Set oRecordSet = Nothing
                    
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:="Успешно!")
                End If
                
                If Not CheckArray(aObjCode) Then
                    ReDim Preserve aObjCode(0), aEodNastr(0)
                Else
                    ReDim Preserve aObjCode(UBound(aObjCode, 1) + 1), aEodNastr(UBound(aEodNastr, 1) + 1)
                End If
                
                aObjCode(UBound(aObjCode, 1)) = cObjCode
                aEodNastr(UBound(aEodNastr, 1)) = cEodNastr
            Else
                cEodNastr = aEodNastr(nCnt)
            End If
            
            bUseZero = False
            nEodNastr = -1
            If cEodNastr <> "" Then
                aNastr = VBA.Split(cEodNastr, "#")
                cEodNastr = ""
                If UBound(aNastr, 1) > 0 Then
                    Select Case VBA.Trim(cObjCode)
                        Case "DOCUMENTS_ZAYAVKA_BUD"
                            bUseZero = ((VBA.Val(aNastr(0)) And (2 ^ 4)) = (2 ^ 4))
                            cEodNastr = "Режим: [ДОКУМЕНТЫ]-[Кассовый план]-[Заявка бюджетополучателя]-[Прием данных MS Excel]-[Настройки]-[Контроль при приеме]"
                        Case "DOCUMENTS_CASH_PLAN_EXPEND"
                            bUseZero = ((VBA.Val(aNastr(0)) And (2 ^ 3)) = (2 ^ 3))
                            cEodNastr = "Режим: [ДОКУМЕНТЫ]-[Кассовый план]-[Кассовый план выплат]-[Прием данных MS Excel]-[Настройки]-[Контроль при приеме]"
                        Case "DOCUMENTS_CASH_PLAN_INCOME"
                            bUseZero = ((VBA.Val(aNastr(0)) And (2 ^ 3)) = (2 ^ 3))
                            cEodNastr = "Режим: [ДОКУМЕНТЫ]-[Кассовый план]-[Кассовый план поступлений]-[Прием данных MS Excel]-[Настройки]-[Контроль при приеме]"
                        Case "DOCUMENTS_0504817"
                            ' bUseZero = ((VBA.Val(aNastr(0)) And (2 ^ 1)) = (2 ^ 1))
                            bUseZero = True
                            cEodNastr = "Режим: [ДОКУМЕНТЫ]-[Бюджетные данные]-[Уведомление по расчетам между бюджетами по МБТ]-[Прием данных MS Excel]-[Настройки]-[Контроль при приеме]"
                        Case Else
                            cEodNastr = ""
                    End Select
                    
                    If Not bFoundObjCode Then
                        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:=cEodNastr)
                        
                        For nEodNastr = 1 To UBound(aNastr, 1)
                            cEodNastr = VBA.IIf((VBA.Val(aNastr(0)) And (2 ^ (nEodNastr - 1))) = (2 ^ (nEodNastr - 1)), "[x] ", "[  ] ") + VBA.Trim(aNastr(nEodNastr))
                            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:=cEodNastr)
                        Next nEodNastr
                    End If
                    
                    nEodNastr = VBA.Val(aNastr(0))
                End If
            End If
        End If
        
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, bStatus:=True _
            , cInfo:="Обработка данных страницы: " + oSheet.Name, nMode:=1 + 4)
        
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, bStatus:=True, cInfo:="Анализ объекта данных страницы: " + oSheet.Name)
        If cObjCode <> "" Then
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cInfo:="Код объекта: " + cObjCode)
        Else
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cHtmSpanStyle:="color: #800000; font-weight: bold;" _
                , cInfo:="Ошибка! Неизвестный объект данных страницы!")
        End If
        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cInfo:="", nMode:=1 + 2)
        
        If oSheet.Scripts.Count > 0 And oSheet.Visible = -1 And cObjCode <> "" Then
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, bStatus:=True _
                , cInfo:="Инициализация сохранения (создание таблицы) страницы: " + oSheet.Name)
            
            cSql = ""
            cTabName = ""
            For nCnt = 1 To oSheet.Scripts.Count
                ' по новой схеме
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "ks_sql_begin_") > 0 Then
                    If VBA.Trim(oSheet.Scripts(nCnt).ScriptText) <> "" Then
                        cSql = cSql & VBA.IIf(cSql = "", "", VBA.Chr(10)) & oSheet.Scripts(nCnt).ScriptText
                    End If
                End If
                ' поддержка старой схемы
                If VBA.LCase(VBA.Trim(oSheet.Scripts(nCnt).ID)) = "init_sql" Then
                    If VBA.Trim(oSheet.Scripts(nCnt).ScriptText) <> "" Then
                        cSql = cSql & VBA.IIf(cSql = "", "", VBA.Chr(10)) & "execute A_EXEC '" & oSheet.Scripts(nCnt).ScriptText & "'"
                    End If
                End If
                If VBA.LCase(VBA.Trim(oSheet.Scripts(nCnt).ID)) = "table_name" Then
                    If VBA.Trim(oSheet.Scripts(nCnt).ScriptText) <> "" Then
                        cTabName = VBA.Trim(oSheet.Scripts(nCnt).ScriptText)
                    End If
                End If
            Next nCnt
            
            If cSql <> "" Then
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:=cSql, bBorders:=True)
                oConnection.Execute cSql
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cInfo:="Успешно!", nMode:=1 + 2)
            Else
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cHtmSpanStyle:="color: #800000; font-weight: bold;" _
                    , cInfo:="Ошибка! Отсутствует скрипт инициализации (создание таблицы)!", nMode:=1 + 4)
                GoTo SkipSheet
            End If
            
            nIndex = 0
            cSql = ""
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, bStatus:=True, cInfo:="Перенос данных страницы: " + oSheet.Name)
            For nCnt = 1 To oSheet.Scripts.Count
                Application.StatusBar = "Перенос данных страницы: " + oSheet.Name + ": " + VBA.Replace(VBA.Format(nCnt / oSheet.Scripts.Count, "0%"), cDecimal, ".")
                
                ' по новой схеме
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "ks_sql_body_") > 0 Then
                    cAddr = VBA.Mid(oSheet.Scripts(nCnt).ID, 1 + VBA.Len("ks_sql_body_"))
                    If Not oSheet.Range(cAddr).Locked Then
                        If bUseZero Or (Not bUseZero And oSheet.Range(cAddr).Value <> 0) Then
                            cReplace = VBA.Replace(VBA.Format(VBA.Val(VBA.Trim(VBA.Replace(oSheet.Range(cAddr).Value, cDecimal, "."))), "#.000000"), cDecimal, ".")
                            cReplace = VBA.IIf(cReplace = "", "0.000000", cReplace)
                            cReplaceText = "''" & VBA.Trim(oSheet.Range(cAddr).Value) & "''"
                            
                            If VBA.IsNumeric(oSheet.Range(cAddr).Value) Then
                                cReplaceText = ""
                            Else
                                cReplace = "null"
                            End If
                            
                            cText = oSheet.Scripts(nCnt).ScriptText
                            cText = ReplaceSheetVariable(oSheet, cText, cAddr)
                            
                            ' #this_val
                            '     - численное значение ячейки
                            cText = ReplaceStr(cText, "#this_val", cReplace)
                            ' #this_text
                            '     - текстовое значение ячейки
                            cText = ReplaceStr(cText, "#this_text", cReplaceText)
                            ' #this_date
                            '     - дата-значение ячейки в формате ISO
                            If VBA.IsDate(oSheet.Range(cAddr).Value) Then
                                cText = ReplaceStr(cText, "#this_date", VBA.Format(oSheet.Range(cAddr).Value, "yyyymmdd"))
                            End If
                            ' #this_note
                            '     - комментарий к ячейке
                            If Not oSheet.Range(cAddr).Comment Is Nothing Then
                                cText = ReplaceStr(cText, "#this_note", oSheet.Range(cAddr).Comment.Text)
                            Else
                                cText = ReplaceStr(cText, "#this_note", "")
                            End If
                            ' #this_book
                            '     - имя книги ячейки
                            cText = ReplaceStr(cText, "#this_book", oSheet.Parent.Name)
                            ' #this_sheet
                            '     - имя листа ячейки
                            cText = ReplaceStr(cText, "#this_sheet", oSheet.Name)
                            ' #this_row
                            '     - номер строки ячейки
                            cText = ReplaceStr(cText, "#this_row", VBA.Format(oSheet.Range(cAddr).Row, "0"))
                            ' #this_col
                            '     - номер колонки ячейки
                            cText = ReplaceStr(cText, "#this_col", VBA.Format(oSheet.Range(cAddr).Column, "0"))
                            
                            cSql = cSql & VBA.IIf(cSql = "", "", VBA.Chr(10)) & ReplaceStr(cText, "'null'", "''")
                            nIndex = nIndex + 1
                        End If
                    End If
                End If
                
                ' поддержка старой схемы
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "sql_term_") > 0 Then
                    If cTabName = "" Then
                        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cHtmSpanStyle:="color: #800000; font-weight: bold;" _
                            , cInfo:="Ошибка! Отсутствует код (наименование) таблицы!", nMode:=1 + 4)
                        GoTo SkipSheet
                    End If
                    
                    cAddr = VBA.Mid(oSheet.Scripts(nCnt).ID, 1 + VBA.Len("sql_term_"))
                    If Not oSheet.Range(cAddr).Locked Then
                        If bUseZero Or (Not bUseZero And oSheet.Range(cAddr).Value <> 0) Then
                            cReplace = VBA.Replace(VBA.Format(VBA.Val(VBA.Trim(VBA.Replace(oSheet.Range(cAddr).Value, cDecimal, "."))), "#.000000"), cDecimal, ".")
                            cReplace = VBA.IIf(cReplace = "", "0.000000", cReplace)
                            cReplaceText = "''" & VBA.Trim(oSheet.Range(cAddr).Value) & "''"
                            
                            If VBA.IsNumeric(oSheet.Range(cAddr).Value) Then
                                cReplaceText = "null"
                            Else
                                cReplace = "null"
                            End If
                            
                            cText = oSheet.Scripts(nCnt).ScriptText
                            cText = ReplaceSheetVariable(oSheet, cText, cAddr)
                            
                            ' this_xls_book, this_xls_sheet, this_xls_row, this_xls_col, this_xls_note
                            cText = ReplaceStr(cText, "this_xls_book", "''" + oSheet.Parent.Name + "''")
                            cText = ReplaceStr(cText, "this_xls_sheet", "''" + oSheet.Name + "''")
                            cText = ReplaceStr(cText, "this_xls_row", VBA.Format(oSheet.Range(cAddr).Row, "0"))
                            cText = ReplaceStr(cText, "this_xls_col", VBA.Format(oSheet.Range(cAddr).Column, "0"))
                            If Not oSheet.Range(cAddr).Comment Is Nothing Then
                                cText = ReplaceStr(cText, "this_xls_note", "''" + oSheet.Range(cAddr).Comment.Text + "''")
                            Else
                                cText = ReplaceStr(cText, "this_xls_note", "null")
                            End If
                            
                            cSql = cSql & VBA.IIf(cSql = "", "", VBA.Chr(10)) & "execute A_EXEC 'INSERT " & cTabName & " " & ReplaceStr(ReplaceStr(ReplaceStr(cText, "thischar", cReplaceText), "this", cReplace), "'null'", "''") & "'"
                            nIndex = nIndex + 1
                        End If
                    End If
                End If
                
                If nIndex >= 300 Or VBA.Len(cSql) > 5000 Then
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:=cSql, bBorders:=True)
                    oConnection.Execute cSql
                    nIndex = 0
                    cSql = ""
                End If
            Next nCnt
            
            If cSql <> "" Then
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:=cSql, bBorders:=True)
                oConnection.Execute cSql
            End If
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cInfo:="Успешно!", nMode:=1 + 2)
            
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, bStatus:=True _
                , cInfo:="Контроль данных Центром Контроля и сохранение данных на сервере страницы: " + oSheet.Name, nMode:=1 + 4)
            
            cSql = ""
            For nCnt = 1 To oSheet.Scripts.Count
                ' по новой схеме
                If VBA.InStr(oSheet.Scripts(nCnt).ID, "ks_sql_end_") > 0 Then
                    If VBA.Trim(oSheet.Scripts(nCnt).ScriptText) <> "" Then
                        cSql = cSql & VBA.IIf(cSql = "", "", VBA.Chr(10)) & oSheet.Scripts(nCnt).ScriptText
                    End IF
                End If
                ' поддержка старой схемы
                If VBA.LCase(VBA.Trim(oSheet.Scripts(nCnt).ID)) = "save_proc" Then
                    If VBA.Trim(oSheet.Scripts(nCnt).ScriptText) <> "" Then
                        cSql = cSql & VBA.IIf(cSql = "", "", VBA.Chr(10)) & oSheet.Scripts(nCnt).ScriptText
                    End If
                End If
            Next nCnt
            
            If cSql <> "" Then
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:=cSql, bBorders:=True)
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:="Результаты процедур Центра Контроля и сохранения данных")
                
                Set oRecordSet = CreateObject("ADODB.RecordSet")
                oRecordSet.Open cSql, oConnection, 2, 3, 1
                
                cFullHtml = ""   ' полный html
                cHtml = ""       ' текущий html с таблицами
                cHeader = ""     ' "шапка" текущего блока html
                cFooter = ""     ' "хвост" текущего блока html
                cParameters = "" ' перечень дополнительных параметров для подготовки протокола
                
                bRecordSetNext = False
                nResult = 0
                nHeaderResult = 0
                nResultControl = 1
                bExistsXMLColumn = False
                
                While Not oRecordSet Is Nothing
                    If oRecordSet.State = 1 Then
                        
                        bXMLHeader = False
                        bXMLColumn = False
                        bResultControl = False
                        For nFields = 1 To oRecordSet.Fields.Count
                            If VBA.UCase(oRecordSet.Fields(nFields - 1).Name) = VBA.UCase("XMLHeader") Then
                                bXMLHeader = True
                            End If
                            
                            If VBA.UCase(oRecordSet.Fields(nFields - 1).Name) = VBA.UCase("XMLColumn") Then
                                bXMLColumn = True
                            End If
                            
                            If VBA.UCase(oRecordSet.Fields(nFields - 1).Name) = VBA.UCase("ResultControl") Then
                                bResultControl = True
                            End If
                        Next
                        
                        ' результат контроля
                        If bResultControl And oRecordSet.RecordCount > 0 Then
                            oRecordSet.MoveFirst
                            While Not oRecordSet.EOF
                                nResultControl = VBA.IIf(nResultControl > VBA.Val(oRecordSet.Fields("ResultControl").Value) _
                                    , nResultControl _
                                    , VBA.Val(oRecordSet.Fields("ResultControl").Value))
                                oRecordSet.MoveNext
                            Wend
                        End If
                        
                        ' курсор с заголовком протокола
                        If bXMLHeader And oRecordSet.RecordCount > 0 Then
                            ' если в переменных cHeader, cFooter или cHtml что то есть - добавляем их в протокол
                            ' но не добавляем в протокол, если есть только шапка протокола с cRepResult=1 и нет табличных данных
                            ' по аналогии с веб для протокола из ХП dbo.SAVE
                            If (cHeader <> "" Or cFooter <> "" Or cHtml <> "") And (nHeaderResult <> 1 Or bExistsXMLColumn) Then
                                cFullHtml = cFullHtml + cHeader + cHtml + cFooter
                                cHtml = ""
                            End If
                            
                            cHeader = ""
                            cFooter = ""
                            nHeaderResult = 0
                            cParameters = ""
                            
                            oRecordSet.MoveFirst
                            While Not oRecordSet.EOF
                                If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cRepHeader") Then
                                    cHeader = VBA.Trim(oRecordSet.Fields("value").Value)
                                End If
                                
                                If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cRepFooter") Then
                                    cFooter = VBA.Trim(oRecordSet.Fields("value").Value)
                                End If
                                
                                If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cRepResult") Then
                                    nHeaderResult = VBA.Val(oRecordSet.Fields("value").Value)
                                    nResult = VBA.IIf(nResult > nHeaderResult, nResult, nHeaderResult)
                                End If
                                
                                If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cParameters") Then
                                    cParameters = VBA.Trim(oRecordSet.Fields("value").Value)
                                End If
                                
                                oRecordSet.MoveNext
                            Wend
                        End If
                        
                        ' курсор с описанием данных
                        If bXMLColumn And oRecordSet.RecordCount > 0 Then
                            ' данные выводим только когда cRepResult заголовка протокола>1 (принудитеьлный вывод без табличных данных)
                            ' или когда cRepResult для заголовка вообще не было
                            bExistsXMLColumn = (bXMLColumn And oRecordSet.RecordCount > 0)
                            
                            oRecordSet.MoveFirst
                            While Not oRecordSet.EOF
                                If VBA.Trim(cHeader) = "" Then
                                    If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cRepHeader") Then
                                        cHeader = VBA.Trim(oRecordSet.Fields("value").Value)
                                    End If
                                End If
                                
                                If VBA.Trim(cFooter) = "" Then
                                    If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cRepFooter") Then
                                        cFooter = VBA.Trim(oRecordSet.Fields("value").Value)
                                    End If
                                End If
                                
                                If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cRepResult") Then
                                    nResult = VBA.IIf(nResult > VBA.Val(oRecordSet.Fields("value").Value) _
                                        , nResult _
                                        , VBA.Val(oRecordSet.Fields("value").Value))
                                End If
                                
                                If VBA.Trim(VBA.UCase(oRecordSet.Fields("code").Value)) = VBA.UCase("cDataDesc") Then
                                    bRecordSetNext = True
                                End If
                                
                                oRecordSet.MoveNext
                            Wend
                            
                            If bRecordSetNext Then
                                Set oRecordSetDesc = oRecordSet.Clone()
                                Set oRecordSet = oRecordSet.NextRecordset
                                If Not oRecordSetDesc Is Nothing And Not oRecordSet Is Nothing Then
                                    If oRecordSetDesc.State = 1 And oRecordSet.State = 1 Then
                                        cHtmlAdd = ""
                                        
                                        If oRecordSetDesc.RecordCount > 0 And oRecordSet.RecordCount > 0 Then
                                            cGrpFld = ""
                                            cGrpDesc = ""
                                            
                                            oRecordSetDesc.MoveFirst
                                            While Not oRecordSetDesc.EOF
                                                If VBA.Trim(VBA.UCase(oRecordSetDesc.Fields("code").Value)) = VBA.Trim(VBA.UCase("cGroupFields")) Then
                                                    cGrpFld = VBA.Trim(oRecordSetDesc.Fields("value").Value)
                                                End If
                                                
                                                If VBA.Trim(VBA.UCase(oRecordSetDesc.Fields("code").Value)) = VBA.Trim(VBA.UCase("cGroupDesc")) Then
                                                    cGrpDesc = VBA.Trim(oRecordSetDesc.Fields("value").Value)
                                                End If
                                                
                                                oRecordSetDesc.MoveNext
                                            Wend
                                            
                                            cDateFld = ""
                                            aGrpFld = VBA.Split(cGrpFld, "|")
                                            For nFldCnt = 0 To UBound(aGrpFld, 1)
                                                cTmp = aGrpFld(nFldCnt)
                                                If VBA.InStr(1, cGrpDesc, "@#DATE#" + cTmp) > 0 Then
                                                    cDateFld = cDateFld + "#" + cTmp + "#"
                                                End If
                                            Next nFldCnt
                                            cGrpDesc = VBA.Replace(cGrpDesc, "@#DATE#", "@")
                                            
                                            Set oXmlData = XmlCreateDomDocument()
                                            oRecordSet.MoveFirst
                                            Call oRecordSet.Save(oXmlData, 1)
                                            
                                            Set oNodeList = oXmlData.DocumentElement.SelectNodes("*")
                                            If oNodeList.Length > 0 Then
                                                For Each oNodeData In oNodeList
                                                    If oNodeData.nodeName Like "*:data" Or oNodeData.nodeName = "data" Then
                                                        For Each oNodeRow In oNodeData.SelectNodes("*")
                                                            If oNodeRow.nodeName Like "*:row" Or oNodeRow.nodeName = "row" Then
                                                                cTmpFld = "|" + VBA.Trim(cGrpFld) + "|"
                                                                cTmpDesc = cGrpDesc
                                                                
                                                                If VBA.Trim(cGrpFld) <> "" Then
                                                                    For nFldCnt = 0 To UBound(aGrpFld, 1)
                                                                        cTmp = aGrpFld(nFldCnt)
                                                                        cAttr = oNodeRow.getAttribute(cTmp)
                                                                        If VBA.InStr(1, cDateFld, "#" + cTmp + "#") > 0 Then
                                                                            If VBA.InStr(1, cAttr, "T") > 0 Then
                                                                                cAttr = VBA.Left(cAttr, VBA.InStr(1, cAttr, "T") - 1)
                                                                            End If
                                                                            
                                                                            cVal = VBA.IIf( _
                                                                                VBA.Trim(cAttr) <> "" _
                                                                                , VBA.Trim(VBA.Format(cAttr, "dd.mm.yyyy")) _
                                                                                , "б/д" _
                                                                            )
                                                                        Else
                                                                            cVal = VBA.Trim(cAttr)
                                                                        End If
                                                                        cTmpFld = VBA.Replace(cTmpFld, "|" + VBA.Trim(cTmp) + "|", "|" + VBA.Trim(cVal) + "|", 1, 99, 1)
                                                                        cTmpDesc = VBA.Replace(cTmpDesc, "@" + VBA.Trim(cTmp), cVal, 1, 99, 1)
                                                                    Next nFldCnt
                                                                End If
                                                                
                                                                cTmpFld = VBA.Trim(VBA.Replace(cTmpFld, "|", " "))
                                                                Call oNodeRow.setAttribute("cgroupfields", cTmpFld)
                                                                Call oNodeRow.setAttribute("cgroupdesc", cTmpDesc)
                                                            End If
                                                        Next oNodeRow
                                                    End If
                                                Next oNodeData
                                            End If
                                            
                                            ' описания cXmlDesc
                                            cXmlDesc = XmlCreateFromRecordSet(oRecordSetDesc)
                                            cXmlDesc = XmlGetRowOnly(cXmlDesc)
                                            cXmlDesc = "<?xml version = ""1.0"" encoding=""Windows-1251"" standalone=""yes""?>" _
                                                + VBA.vbNewLine + "<VFPData>" _
                                                + VBA.vbNewLine + cXmlDesc _
                                                + VBA.vbNewLine + "</VFPData>" _
                                                + VBA.vbNewLine
                                                
                                            ' вспомогательное преобразование описаний cXmlDesc
                                            cXsltDesc = ScriptGet(oSheet, "XMLReportDescXslt")
                                            cXmlDesc = XmlTransform(cXmlDesc, cXsltDesc)
                                            
                                            ' данные cXmlData
                                            cXmlData = oXmlData.XML
                                            
                                            ' убираем лишние тэги
                                            cXmlDesc = VBA.Right(cXmlDesc, VBA.Len(cXmlDesc) - VBA.InStr(1, cXmlDesc, ">"))
                                            cXmlData = XmlGetRowOnly(cXmlData)
                                            
                                            ' формируем общий xml
                                            cXmlFull = "<?xml version = ""1.0"" encoding=""Windows-1251""?>" _
                                                + VBA.vbNewLine + "<root>" _
                                                + VBA.vbNewLine + cXmlDesc _
                                                + VBA.vbNewLine + "<data>" _
                                                + VBA.vbNewLine + cXmlData _
                                                + VBA.vbNewLine + "</data>" _
                                                + VBA.vbNewLine + "</root>" _
                                                + VBA.vbNewLine
                                            
                                            ' основное преобразование
                                            cXsltFull = ScriptGet(oSheet, "XMLReportXslt")
                                            cHtmlAdd = XmlTransform(cXmlFull, cXsltFull)
                                        End If
                                        
                                        cHtml = cHtml + cHtmlAdd
                                    End If
                                End If
                                
                                bRecordSetNext = False
                                If Not oRecordSetDesc Is Nothing Then
                                    If oRecordSetDesc.State = 1 Then oRecordSetDesc.Close
                                End If
                                Set oRecordSetDesc = Nothing
                            End If
                        End If
                    End If
                    
                    Set oRecordSet = oRecordSet.NextRecordset
                Wend
                
                If (cHeader <> "" Or cFooter <> "" Or cHtml <> "") And (nHeaderResult <> 1 Or bExistsXMLColumn) Then
                    cFullHtml = cFullHtml + cHeader + cHtml + cFooter
                End If
                
                If cFullHtml <> "" Then
                    If nModeSave = 0 Then
                        Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=4, cInfo:=cFullHtml)
                    Else
                        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogSql, cInfo:="<TABLE STYLE=""FONT-SIZE: X-SMALL""><TR><TD>", nMode:=1 + 4)
                        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogSql, nLevel:=4, cInfo:="", nMode:=1 + 4)
                        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogSql, cInfo:="</TD><TD><TABLE STYLE=""FONT-SIZE: X-SMALL""><TR><TD>", nMode:=1 + 4)
                        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogSql, cInfo:=VBA.Replace(cFullHtml, "<HR>", ""), nMode:=1 + 4)
                        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogSql, cInfo:="</TD></TR></TABLE></TD></TR></TABLE>", nMode:=1 + 4)
                    End If
                    
                    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, cInfo:="<TABLE STYLE=""FONT-SIZE: X-SMALL""><TR><TD>", nMode:=1 + 4)
                    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=3, cInfo:="", nMode:=1 + 4)
                    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, cInfo:="</TD><TD><TABLE STYLE=""FONT-SIZE: X-SMALL""><TR><TD>", nMode:=1 + 4)
                    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, cInfo:=VBA.Replace(cFullHtml, "<HR>", ""), nMode:=1 + 4)
                    Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, cInfo:="</TD></TR></TABLE></TD></TR></TABLE>", nMode:=1 + 4)
                End If
                
                If Not oRecordSet Is Nothing Then
                    If oRecordSet.State = 1 Then oRecordSet.Close
                End If
                Set oRecordSet = Nothing
                
                nErrorControl = VBA.IIf(nResultControl > nErrorControl, nResultControl, nErrorControl)
                If nResultControl > 2 Then
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cHtmSpanStyle:="color: #800000; font-weight: bold;" _
                        , cInfo:="Имеются не пройденные блокирующие контроли ЦК, сохранение таких данных невозможно!", nMode:=1 + 4)
                    GoTo SkipSheet1
                Else
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cInfo:="Успешно!", nMode:=1 + 2 + 4)
                End If
            Else
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cHtmSpanStyle:="color: #800000; font-weight: bold;" _
                    , cInfo:="Ошибка! Отсутствует скрипт сохранения данных!", nMode:=1 + 4)
                GoTo SkipSheet
            End If
            
            cProperty = ScriptGet(oSheet, "del_file")
            If cProperty <> "" Then
                Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=2, bStatus:=True, cInfo:="Дополнительные действия после сохранения")
                If VBA.Dir(cProperty) <> "" Then
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:="Удаление файла: " + cProperty)
                    Call VBA.Kill(cProperty)
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:="Успешно!", nMode:=1 + 2)
                Else
                    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, nLevel:=3, cInfo:="Успешно!", nMode:=1 + 2)
                End If
            End If
            
            tPhaseBegin = tSheetBegin
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1 _
                , cInfo:="Данные страницы: " + oSheet.Name + " успешно обработаны!", nMode:=1 + 4)
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="", nMode:=1 + 2 + 4)
        Else
            Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=3, cHtmSpanStyle:="color: #800000; font-weight: bold;" _
                , cInfo:="Ошибка! Страница: " + oSheet.Name + " не содержит конструкций сохранения!", nMode:=1 + 4)
            GoTo SkipSheet
        End If
NextSheet:
    Next oSheet

    nErrorSave = VBA.IIf(nErrorControl > nErrorSave, nErrorControl, nErrorSave)
    
    tPhaseBegin = tBookBegin
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Итоги всех действий", nMode:=1 + 4)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="", nMode:=1 + 2 + 4)
    
    If nModeSave = 0 Then
        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Системный протокол приема")
        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="<a href=""file://" + VBA.Replace(cLogSql, "\", "/") + """>" + cLogSql + "</a>")
        Call PutInfo(nModeTxt:=nModeSave, cFileHtm:=cLogCtl, cInfo:=cLogCtlEnd)
    End If
    Call ServerConnectClose
    
    Application.StatusBar = False
    oBook.Saved = True
    Application.ThisWorkbook.Saved = True
    
    Call ChangeToolbar(2)
    If nModeSave = 0 Then
        nVal = VBA.MsgBox( _
            VBA.IIf(nErrorSave = 1, "Документ успешно обработан!", _
            VBA.IIf(nErrorSave = 2, "Имеются не пройденные информационные контроли, документ успешно обработан!", _
            VBA.IIf(nErrorSave = 3, "Имеются не пройденные блокирующие контроли, сохранение таких данных невозможно!", _
            VBA.IIf(nErrorSave = 4, "В процессе приема обнаружены ошибки, сохранение таких данных невозможно!", _
            "Неизвестная ошибка, сохранение таких данных невозможно!")))) + VBA.vbNewLine _
            + VBA.vbNewLine + "Протокол приема смотрите в файле:" _
            + VBA.vbNewLine + cLogCtl _
            + VBA.vbNewLine + "Открыть файл для просмотра?" _
            , VBA.vbYesNo + VBA.vbInformation, "Внимание")
        If nVal = 6 Then
            cCmd = "iexplore.exe " + cLogCtl
            RetVal = WshShell.Run(cCmd, 1, False)
        End If
    End If
    
    Exit Sub

ErrSheet:
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, _
                cHtmSpanStyle:="color: #800000; font-weight: bold;", _
                cInfo:=ShowErrorEvent(cSubName:="ReportSaveServer", bShowMsgBox:=False, bAdoErrorCheck:=True, bExecAppEnabled:=False), _
                nMode:=1 + 4)

SkipSheet:
    nErrorSave = 4

SkipSheet1:
    tPhaseBegin = tSheetBegin
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1 _
        , cInfo:="Данные страницы: " + oSheet.Name + VBA.IIf(nErrorSave = 4, " не сохранены на сервер!", " успешно обработаны!") _
        , nMode:=1 + 4)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="", nMode:=1 + 2 + 4)
    GoTo NextSheet

ErrMain:
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, _
                cHtmSpanStyle:="color: #800000; font-weight: bold;", _
                cInfo:=ShowErrorEvent(cSubName:="ReportSaveServer", bShowMsgBox:=False, bAdoErrorCheck:=True, bExecAppEnabled:=False), _
                nMode:=1 + 4)

    Call ServerConnectClose
    Application.StatusBar = False

    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1 _
        , cInfo:="Данные книги MS Excel: " + oBook.Name + " не сохранены на сервер!", nMode:=1 + 4)
    
    tPhaseBegin = tBookBegin
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=1, cInfo:="Итоги всех действий", nMode:=1 + 4)
    Call PutInfo(nModeTxt:=nModeSave, cFileTxt:=cLogSql, cFileHtm:=cLogCtl, nLevel:=2, cInfo:="", nMode:=1 + 2 + 4)
    
    If nModeSave = 0 Then
        nVal = VBA.MsgBox("В процессе приема обнаружены системные ошибки!" + VBA.vbNewLine _
                    + VBA.vbNewLine + "Системный протокол приема смотрите в файле:" _
                    + VBA.vbNewLine + cLogSql _
                    + VBA.vbNewLine + "Открыть файл для просмотра?" _
                    , VBA.vbYesNo + VBA.vbInformation, "Внимание")
        If nVal = 6 Then
            cCmd = "notepad.exe " + GetShortPath(cLogSql)
            RetVal = WshShell.Run(cCmd, 1, False)
        End If
    End If
    
    nErrorSave = 4
End Sub
' -------------------------------------------------------------------------------------------------------
Sub ServerConnectClose()
    On Error GoTo doError
    
    If Not VBA.IsEmpty(oConnection) Then
        If Not oConnection Is Nothing Then
            oConnection.Close
        End If
    End If
    Set oConnection = Nothing
    Exit Sub
    
doError:
    Call ShowErrorEvent("ServerConnectClose")
End Sub
' -------------------------------------------------------------------------------------------------------
Function ServerConnectOpen(ByVal oBook As Workbook, ByRef cRetSrv As String, ByRef cRetDb As String, ByRef cRetUser As String) As String
    Dim cSrv As String, cDb As String, cUser As String, cCorr As String, oSheet As Worksheet, nCnt As Long _
        , aSrv() As String, aDb() As String, aUser() As String, aCorr() As String, aIsNtUser() As Long, nIndex As Long _
        , bFound As Boolean, cPrompt As String, nIsNtUser As Long
    
    On Error GoTo doError
    
    nCnt = 0
    For Each oSheet In oBook.Sheets
        If oSheet.Scripts.Count > 0 And oSheet.Visible = -1 Then
            cSrv = ScriptGet(oSheet, "srv_name")
            cDb = ScriptGet(oSheet, "db_name")
            cUser = ScriptGet(oSheet, "dbuser_name")
            cCorr = ScriptGet(oSheet, "corr_out")
            nIsNtUser = VBA.Val(ScriptGet(oSheet, "dbuser_isnt"))
            
            If cSrv <> "" And cDb <> "" And cUser <> "" Then
                If nCnt = 0 Then
                    ReDim Preserve aSrv(nCnt), aDb(nCnt), aUser(nCnt), aCorr(nCnt), aIsNtUser(nCnt)
                    aSrv(nCnt) = cSrv
                    aDb(nCnt) = cDb
                    aUser(nCnt) = cUser
                    aCorr(nCnt) = cCorr
                    aIsNtUser(nCnt) = nIsNtUser
                    nCnt = nCnt + 1
                Else
                    bFound = False
                    For nIndex = 0 To nCnt - 1
                        If cSrv = aSrv(nIndex) And cDb = aDb(nIndex) And cUser = aUser(nIndex) And cCorr = aCorr(nIndex) Then
                            bFound = True
                        End If
                    Next nIndex
                    
                    If Not bFound Then
                        ReDim Preserve aSrv(nCnt), aDb(nCnt), aUser(nCnt), aCorr(nCnt), aIsNtUser(nCnt)
                        aSrv(nCnt) = cSrv
                        aDb(nCnt) = cDb
                        aUser(nCnt) = cUser
                        aCorr(nCnt) = cCorr
                        aIsNtUser(nCnt) = nIsNtUser
                        nCnt = nCnt + 1
                    End If
                End If
            End If
        End If
    Next oSheet
    
    If nCnt = 0 Then
        ServerConnectOpen = "Книга [" + oBook.Name + "] не содержит информации о базе и сервере!"
        Exit Function
    End If
    
    If nCnt > 1 Then
        cPrompt = ""
        For nIndex = 0 To nCnt - 1
            cPrompt = cPrompt + VBA.Trim(VBA.str(nIndex + 1)) + " - Сервер: [" + aSrv(nIndex) + "], база: [" + aDb(nIndex) + "], пользователь: [" + aUser(nIndex) + "]." + VBA.vbNewLine
        Next nIndex
        
        cPrompt = cPrompt + "0 - Выход."
        cPrompt = VBA.InputBox(cPrompt, "Выберите вариант подключения")
        nIndex = VBA.Val(cPrompt)
        
        If 1 <= nIndex And nIndex <= nCnt Then
            cSrv = aSrv(nIndex - 1)
            cDb = aDb(nIndex - 1)
            cUser = aUser(nIndex - 1)
            cCorr = aCorr(nIndex - 1)
            nIsNtUser = aIsNtUser(nIndex - 1)
        Else
            ServerConnectOpen = "Пользователь не выбрал вариант подключения!"
            Exit Function
        End If
    Else
        cSrv = aSrv(0)
        cDb = aDb(0)
        cUser = aUser(0)
        cCorr = aCorr(0)
        nIsNtUser = aIsNtUser(0)
    End If
    cRetSrv = cSrv
    cRetDb = cDb
    cRetUser = cUser
    
    Set oConnection = CreateObject("ADODB.Connection")
    If nIsNtUser = 1 Then
        oConnection.ConnectionString = "Provider=SQLOLEDB;Server=" + cSrv + ";Database=" + cDb + ";Trusted_Connection=yes;"
    Else
        oConnection.ConnectionString = "Provider=SQLOLEDB;Server=" + cSrv + ";Database=" + cDb + ";Uid=" + cUser + ";Pwd=" + GetCode(cCorr)
    End If
    oConnection.ConnectionTimeout = 0
    oConnection.CommandTimeout = 0
    oConnection.CursorLocation = 3
    oConnection.Mode = 3
    oConnection.Open
    
    oConnection.Execute "SET LANGUAGE ENGLISH"
    oConnection.Execute "SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED"
    oConnection.Execute "SET QUOTED_IDENTIFIER ON"
    oConnection.Execute "SET ANSI_NULLS ON"
    oConnection.Execute "SET ARITHABORT ON"
    oConnection.Execute "SET CONCAT_NULL_YIELDS_NULL ON"
    oConnection.Execute "SET ANSI_PADDING ON"
    oConnection.Execute "SET ANSI_WARNINGS ON"
    oConnection.Execute "SET NUMERIC_ROUNDABORT OFF"
    oConnection.Execute "SET NOCOUNT ON"
    oConnection.Execute "SET XACT_ABORT ON"
    
    ServerConnectOpen = ""
    Exit Function
    
doError:
    Call ServerConnectClose
    ServerConnectOpen = "Ошибка! Номер: " + VBA.str(Err.Number) + ", источник: " + Err.Source + ", описание: " + Err.Description
End Function
' -------------------------------------------------------------------------------------------------------
Function ShowErrorEvent(Optional ByVal cSubName As String = "", _
                        Optional ByVal bShowMsgBox As Boolean = True, _
                        Optional ByVal bAdoErrorCheck As Boolean = False, _
                        Optional ByVal cErrorMessageEnd As String = "", _
                        Optional ByVal bExecAppEnabled As Boolean = True) As String
    Dim cErrorMessage As String, nErr As Long
    
    cErrorMessage = VBA.IIf(cSubName = "", "", "Процедура(функция): " + cSubName + VBA.vbNewLine) _
                    + "Ошибка! Номер: " + VBA.Trim(VBA.Str(Err.Number)) _
                    + ", Источник: " + VBA.Trim(Err.Source) _
                    + VBA.vbNewLine + "Описание: " + VBA.Trim(Err.Description)
    
    If bAdoErrorCheck Then
        If Not oConnection Is Nothing Then
            If oConnection.Errors.Count > 0 Then
                cErrorMessage = VBA.IIf(cSubName = "", "", "Процедура(функция): " + cSubName + VBA.vbNewLine)
                For nErr = 0 To oConnection.Errors.Count - 1
                    cErrorMessage = cErrorMessage _
                                    + "Ошибка! Номер: " + VBA.Trim(VBA.Str(oConnection.Errors(nErr).Number)) _
                                    + ", Источник: " + VBA.Trim(VBA.CStr(oConnection.Errors(nErr).Source)) _
                                    + VBA.vbNewLine + "Описание: " + VBA.Trim(VBA.CStr(oConnection.Errors(nErr).Description))
                Next nErr
            End If
        End If
    End If
    
    If VBA.Trim(cErrorMessageEnd) <> "" Then
        cErrorMessage = cErrorMessage + VBA.vbNewLine + cErrorMessageEnd
    End If
    
    ShowErrorEvent = cErrorMessage
    If bShowMsgBox Then
        Call VBA.MsgBox(cErrorMessage, VBA.vbOKOnly + VBA.vbCritical, "Ошибка в программе")
    End If
    
    If bExecAppEnabled Then
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.Interactive = True
        Application.StatusBar = False
        Application.Calculation = xlCalculationAutomatic
    End If
End Function
' -------------------------------------------------------------------------------------------------------
Function XmlCreateDomDocument(Optional ByRef cXmlVersion As String = "") As Variant
    Dim oXmlDom, cXmlObject As String
    
    Set oXmlDom = Nothing
    If cXmlVersion = "" Then
        cXmlVersion = "6.0"
    End If
    
    Select Case cXmlVersion
    Case "3.0"
        ' http://www.microsoft.com/downloads/details.aspx?familyid=28494391-052b-42ff-9674-f752bdca9582&displaylang=en
        cXmlObject = "MSXML2.DOMDocument.3.0"
    Case "4.0"
        ' http://www.microsoft.com/downloads/details.aspx?FamilyID=3144b72b-b4f2-46da-b4b6-c5d7485f2b42&DisplayLang=en
        cXmlObject = "MSXML2.DOMDocument.4.0"
    Case "6.0"
        ' http://www.microsoft.com/downloads/details.aspx?familyid=993C0BCF-3BCF-4009-BE21-27E85E1857B1&displaylang=en
        cXmlObject = "MSXML2.DOMDocument.6.0"
    Case Else
        cXmlObject = ""
        cXmlVersion = ""
    End Select
    
    If cXmlObject <> "" And oXmlDom Is Nothing Then
        On Error GoTo LError
        Set oXmlDom = CreateObject(cXmlObject)
        GoTo LExit
LError:
        Set oXmlDom = Nothing
        Select Case cXmlVersion
        Case "3.0"
            cXmlVersion = ""
        Case "4.0"
            cXmlVersion = "3.0"
        Case "6.0"
            cXmlVersion = "4.0"
        Case Else
            cXmlVersion = ""
        End Select
        
        If cXmlVersion <> "" Then
            Set oXmlDom = XmlCreateDomDocument(cXmlVersion)
        End If
LExit:
        On Error GoTo 0
    End If
    
    If cXmlVersion = "" Then
        Set oXmlDom = Nothing
    End If
    
    Set XmlCreateDomDocument = oXmlDom
End Function
' -------------------------------------------------------------------------------------------------------
Function XmlCreateFromRecordSet(ByVal oRecordSet As Variant, Optional ByVal cXslt As String = "") As String
    Dim cXmlResult As String, oXmlDom
    
    On Error GoTo doError
    
    cXmlResult = ""
    Set oXmlDom = XmlCreateDomDocument()
    
    If Not oXmlDom Is Nothing Then
        ' преобразовываем курсор
        oRecordSet.MoveFirst
        Call oRecordSet.Save(oXmlDom, 1)
        
        cXmlResult = oXmlDom.XML
        ' cXmlResult = VBA.Replace(cXmlResult, "encoding=""UTF-8""", "encoding=""windows-1251""")
        
        ' если нужно, выполняем преобразование
        If VBA.Trim(cXslt) <> "" Then
            ' необходимо выполнить предварительное преобразование. Преобразовываем в переменную
            cXmlResult = XmlTransform(cXmlResult, cXslt)
            
            ' почему - то когда преобразовываем через переменную, а не через файл, то msxml вставляет всегда encoding utf-16
            ' cXmlResult = VBA.Replace(cXmlResult, "encoding=""UTF-16""", "encoding=""windows-1251""")
        End If
    End If
    
    Set oXmlDom = Nothing
    XmlCreateFromRecordSet = cXmlResult
    Exit Function
    
doError:
    XmlCreateFromRecordSet = ""
    Call ShowErrorEvent("XmlCreateFromRecordSet")
End Function
' -------------------------------------------------------------------------------------------------------
Function XmlGetRowOnly(ByVal cXml As String) As String
    Dim cXmlResult As String, aXml() As String, cDelimiter As String, nCnt As Long, aTerm As Variant
    
    On Error GoTo doError
    
    cXmlResult = VBA.Trim(cXml)
    If cXmlResult <> "" Then
        aTerm = Array("s", "dt", "rs", "z")
        For nCnt = 0 To UBound(aTerm, 1)
            cXmlResult = VBA.Replace(cXmlResult, "<" + aTerm(nCnt) + ":", "<")
            cXmlResult = VBA.Replace(cXmlResult, "</" + aTerm(nCnt) + ":", "</")
        Next nCnt
        
        cDelimiter = ""
        If cDelimiter = "" And VBA.InStr(1, cXmlResult, ":data>") > 0 Then
            cDelimiter = ":data>"
        End If
        If cDelimiter = "" And VBA.InStr(1, cXmlResult, "<data>") > 0 Then
            cDelimiter = "data>"
        End If
        
        If cDelimiter <> "" Then
            aXml = VBA.Split(cXmlResult, cDelimiter)
            If UBound(aXml, 1) = 2 Then
                cXmlResult = aXml(1)
                For nCnt = VBA.Len(cXmlResult) To 1 Step -1
                    If VBA.Mid(cXmlResult, nCnt, 1) = "<" Then
                        cXmlResult = VBA.Left(cXmlResult, nCnt - 1)
                        Exit For
                    End If
                    
                    If VBA.Mid(cXmlResult, nCnt, 1) = ">" Then
                        Exit For
                    End If
                Next nCnt
            End If
        End If
    End If
    
    XmlGetRowOnly = cXmlResult
    Exit Function
    
doError:
    XmlGetRowOnly = ""
    Call ShowErrorEvent("XmlGetRowOnly")
End Function
' -------------------------------------------------------------------------------------------------------
Function XmlTransform(ByVal cXml As String, Optional ByVal cXslt As String = "") As String
    Dim cXmlResult As String, oXmlDom, oXsltDom
    
    On Error GoTo doError
    
    cXmlResult = ""
    Set oXmlDom = XmlCreateDomDocument()
    Set oXsltDom = XmlCreateDomDocument()
    
    If Not oXmlDom Is Nothing And Not oXsltDom Is Nothing Then
        ' загружаем XML - cXml
        Call oXmlDom.LoadXML(cXml)
        
        ' загружаем XSLT - cXslt
        Call oXsltDom.LoadXML(cXslt)
        
        cXmlResult = oXmlDom.TransformNode(oXsltDom)
    End If
    
    Set oXmlDom = Nothing
    Set oXsltDom = Nothing
    XmlTransform = cXmlResult
    Exit Function
    
doError:
    XmlTransform = ""
    Call ShowErrorEvent("XmlTransform")
End Function
