Attribute VB_Name = "service_s"
Option Explicit

Public cSrv, cDb, cUser, cPwd As String
Public oAdoConnect As Object
Public nNtUser As Long   'Flag: 0 - Sql Connect, 1 - Win Connect
Public ToolbarAction
'---------------------------------------------------------------------------------------------------------------
' Функция открытия ADO соединения с SQL сервером
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Function AdoSrvConnect()

With Sheets("Service")
    'Иницилизация данных
    cSrv = VBA.Trim(.Range("A4").Value)
    cDb = VBA.Trim(.Range("A5").Value)
    cUser = VBA.Trim(.Range("A6").Value)
    cPwd = decode_psw(VBA.Trim(.Range("A21").Value))
    nNtUser = VBA.Val(VBA.Trim(.Range("A22").Value))
End With

        On Error GoTo doError
        Set oAdoConnect = CreateObject("ADODB.Connection")
        If nNtUser = 1 Then ' Win connect
                oAdoConnect.ConnectionString = "Provider=SQLOLEDB;Server=" + cSrv + ";Database=" + cDb + ";Trusted_Connection=yes;"
        Else                ' Sql connect
                oAdoConnect.ConnectionString = "Provider=SQLOLEDB;Server=" + cSrv + ";Database=" + cDb + ";Uid=" + cUser + ";Pwd=" + cPwd
        End If
        oAdoConnect.ConnectionTimeout = 0
        oAdoConnect.CommandTimeout = 0
        oAdoConnect.CursorLocation = 3
        oAdoConnect.mode = 3
        oAdoConnect.Open
        oAdoConnect.Execute "SET LANGUAGE ENGLISH"
        oAdoConnect.Execute "SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED"
        oAdoConnect.Execute "SET QUOTED_IDENTIFIER ON"
        oAdoConnect.Execute "SET ANSI_NULLS ON"
        oAdoConnect.Execute "SET ARITHABORT ON"
        oAdoConnect.Execute "SET CONCAT_NULL_YIELDS_NULL ON"
        oAdoConnect.Execute "SET ANSI_PADDING ON"
        oAdoConnect.Execute "SET ANSI_WARNINGS ON"
        oAdoConnect.Execute "SET NUMERIC_ROUNDABORT OFF"
        oAdoConnect.Execute "SET NOCOUNT ON"
        oAdoConnect.Execute "SET XACT_ABORT ON"
        Exit Function
doError:
    Call AdoSrvDisconnect
    Call ERROR_EVENT("AdoSrvConnect")
End Function
' -------------------------------------------------------------------------------------------------------
' Закрытие ADO соединения с SQL сервером
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub AdoSrvDisconnect()
    
    On Error GoTo doError
    If Not VBA.IsEmpty(oAdoConnect) Then
        If Not oAdoConnect Is Nothing Then
            oAdoConnect.Close
        End If
    End If
    Set oAdoConnect = Nothing
    Exit Sub
doError:
    Call ERROR_EVENT("AdoSrvDisсonnect")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура иницилизации панели инструментов
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Function init_data(Optional s As String = "SAVE_REPORT") As Integer
Dim SheetsService
Dim Found As Boolean, cbar As Object, lBook

    Set ToolbarAction = CommandBars.Add(name:="Меню SQL", Position:=msoBarTop, Temporary:=True)
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
         .FaceId = 3
         .Style = msoButtonIcon
         .Caption = "Сохранить данные отчета на сервере"
         .OnAction = s '"SAVE_REPORT"
    End With
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
         .FaceId = 137
         .Style = msoButtonIcon
         .Caption = "Добавить строку"
         .OnAction = "addStr"
    End With
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
         .FaceId = 138
         .Style = msoButtonIcon
         .Caption = "Удалить строку"
         .OnAction = "delStr"
    End With
    ToolbarAction.Enabled = True
    ToolbarAction.Visible = True

    init_data = 1
    Application.ThisWorkbook.VBProject.name = Application.ThisWorkbook.VBProject.name + "X"
    Application.ThisWorkbook.Saved = True
End Function
'---------------------------------------------------------------------------------------------------------------
' Функция проверки удаляемой строки
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Function checkDataString(row As Integer) As Boolean
Dim F As Boolean, i As Integer
    i = 1
    F = False
    While i < 10 And Not F
        If Not Application.ActiveWorkbook.ActiveSheet.Cells(row, i).Locked Then F = True
        i = i + 1
    Wend
    checkDataString = F
End Function
'---------------------------------------------------------------------------------------------------------------
' Процедура добавления строки
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Sub addStr()
Dim col As Integer

    col = ActiveCell.column
    If checkDataString(ActiveCell.row) Then
        Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row).Insert
        Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row + 1).Copy
        Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Cells(ActiveCell.row, col).Select
    Else
        If checkDataString(ActiveCell.row - 1) Then ' добавляем вниз
            Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row).Insert
            Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row - 1).Copy
            Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            Cells(ActiveCell.row, col).Select
        Else
            Call MsgBox("Попытка добавить строку вне блока данных! " + vbNewLine + "Для добавления используйте стандартные средства EXCEL", vbOKOnly + vbInformation, "Ошибка добавления строки")
        End If
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура удаления строки
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Sub delStr()
    If checkDataString(ActiveCell.row) Then
        Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row).Delete
    Else
        Call MsgBox("Строка не из блока данных! " + vbNewLine + "Для удаления используйте стандартные средства EXCEL", vbOKOnly + vbInformation, "Ошибка удаления строки")
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура сохранения 137-ой формы
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Sub SAVE_REPORT_xxx()
Dim wSheet, SheetsService As Worksheet
Dim i, j, rowFirst, rowLast, colFirst, colLast, fieldsCount, lRazdel, lRazdelCount, lNum As Integer
Dim lCell As Range
Dim fieldsArray(), typeArray(), lRazdelList(), lFieldsArr(), lFieldsTypeArr(), lFieldsNumList() As String
Dim tempStr  As String
Dim tempStr1 As String
Dim tabName, cSql, lFieldsList As String
Dim oRecordSet As Object
    
    cSql = ""
    On Error GoTo doError
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set SheetsService = Application.ActiveWorkbook.Sheets("Service")
    On Error GoTo 0
    Application.StatusBar = "Подождите... Идет подготовка к сохранению данных... "
    On Error GoTo ttt
    If oAdoConnect Is Nothing Then
        Call AdoSrvConnect
    End If
    GoTo lll
ttt:
lll:
    tabName = "##simply" + VBA.Trim(VBA.str(SheetsService.Range("A20")))
    cSql = "IF not object_id(''tempdb.." + tabName + "'') is null DROP TABLE " + tabName + "  CREATE TABLE " + tabName + "(" + SheetsService.Range("A12").Text + ", ROW_ID INT, razdel int)"
    oAdoConnect.Execute ("A_EXEC '" + cSql + "'")
    lRazdelCount = SheetsService.Range("A11")
    ReDim lRazdelList(lRazdelCount)
    SheetsService.Visible = True
    tempStr = SheetsService.Range("A14")
    For i = 1 To SheetsService.Range("A11")
        lRazdelList(i) = getNextSubstr(tempStr, "|")
    Next
    tempStr = SheetsService.Range("A12")
    ReDim lFieldsArr(chr_count(tempStr, ",") + 1)
    ReDim lFieldsTypeArr(chr_count(tempStr, ",") + 1)
    
    For i = 1 To chr_count(tempStr, ",") + 1
        tempStr1 = getNextSubstr(tempStr, ",")
        lFieldsArr(i) = getNextSubstr(tempStr1, " ")
        lFieldsTypeArr(i) = getNextSubstr(tempStr1, " ")
    Next
    ReDim lFieldsNumList(lRazdelCount)
    tempStr = SheetsService.Range("A13")
    For i = 1 To lRazdelCount
        lFieldsNumList(i) = getNextSubstr(tempStr, "|")
    Next
    
    cSql = ""
    'найдем область данных (незащищенные ячейки)
    For lRazdel = 1 To lRazdelCount
        Sheets(lRazdelList(lRazdel)).Select
        Set wSheet = Application.ActiveWorkbook.ActiveSheet
        rowFirst = 0
        rowLast = 0
        Set lCell = StringFunc.LastCell(wSheet.Cells)
        For i = 1 To lCell.row
            If Not wSheet.Cells(i, 2).Locked And rowFirst = 0 Then rowFirst = i
            If wSheet.Cells(i, 2).Locked And rowFirst <> 0 And rowLast = 0 Then rowLast = i - 1
        Next
        
        colFirst = 0
        colLast = 0
        For i = 1 To lCell.column + 1
            If Not wSheet.Cells(rowFirst, i).Locked And colFirst = 0 Then colFirst = i
            If wSheet.Cells(rowFirst, i).Locked And colFirst <> 0 And colLast = 0 Then colLast = i - 1
        Next
     
        fieldsCount = chr_count(lFieldsNumList(lRazdel), ",") + 1
        ReDim fieldsArray(fieldsCount)
        ReDim typeArray(fieldsCount)
        
        tempStr = lFieldsNumList(lRazdel) + ", "
        lFieldsList = "row_id, razdel"
        For i = 1 To fieldsCount
            lNum = VBA.Int(VBA.Val(getNextSubstr(tempStr, ",")))
            fieldsArray(i) = lFieldsArr(lNum)
            typeArray(i) = lFieldsTypeArr(lNum)
            lFieldsList = lFieldsList + ", " + lFieldsArr(lNum)
        Next
        Application.StatusBar = "Подождите... Идет перенос данных на сервер... "
    
        For i = rowFirst To rowLast
            cSql = cSql + " INSERT " + tabName + "(" + lFieldsList + ") VALUES (" + str(i) + ", " + str(lRazdel) + ", "
            For j = 1 To fieldsCount
                If VBA.Left(VBA.UCase(typeArray(j)), 7) = "NUMERIC" Or VBA.UCase(typeArray(j)) = "MONEY" Or VBA.UCase(typeArray(j)) = "INT" Then
                    If IsNumeric(wSheet.Cells(i, colFirst + j - 1).Value) Then
                        cSql = cSql + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                    Else
                        If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                            cSql = cSql + "NULL"
                        Else
                            Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                            wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                            wSheet.Cells(i, colFirst + j - 1).Select
                            GoTo exitFunc
                        End If
                    End If
                Else
                    If VBA.Left(VBA.UCase(typeArray(j)), 7) = "VARCHAR" Then
                        cSql = cSql + "CONVERT(" + typeArray(j) + ",''" + Replace_in_Str(wSheet.Cells(i, colFirst + j - 1).Text, "'", """") + "'')"
                    Else
                        If VBA.Left(VBA.UCase(typeArray(j)), 8) = "DATETIME" Then
                            If IsDate(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                cSql = cSql + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                            Else
                                If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                    cSql = cSql + "NULL"
                                Else
                                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется дата", vbCritical, "Внимание, сохранение не произведено!")
                                    wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                                    wSheet.Cells(i, colFirst + j - 1).Select
                                    GoTo exitFunc
                                End If
                            End If
                        Else
                            Call MsgBox("Неопределенный тип поля " + typeArray(j), vbCritical, "Ошибка !")
                        End If
                    End If
                End If
                If j <> fieldsCount Then cSql = cSql + ", "
            Next
            cSql = cSql + ") "
            ' Выполняем пакет команд
            If VBA.Len(cSql) > 5000 Then
                oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
                cSql = ""
            End If
        Next
    Next
    If cSql <> "" Then
        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
    End If
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    If SheetsService.Range("A17").Text <> "" Then
        Set oRecordSet = CreateObject("ADODB.RecordSet")
        oRecordSet.Open SheetsService.Range("A17"), oAdoConnect, 2, 1, 1
        While Not oRecordSet.EOF
            Sheets(lRazdelList(oRecordSet.Fields("razdel"))).Cells(oRecordSet.Fields("row_id"), 2).Interior.color = RGB(255, 0, 0)
            Sheets(lRazdelList(oRecordSet.Fields("razdel"))).Cells(oRecordSet.Fields("row_id"), 3).Interior.color = RGB(255, 0, 0)
            oRecordSet.MoveNext
            Call MsgBox("Обнаружена ячейка с кодом, отсутствующем в справочнике!", vbCritical, "Внимание, сохранение произведено не корректно!")
        Wend
        oRecordSet.Close
        Set oRecordSet = Nothing
    End If
    If SheetsService.Range("A16").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A16"))
    End If
    If SheetsService.Range("A15").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A15"))
    End If
    Application.StatusBar = False
exitFunc:
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура сохранения 127-ой формы
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Sub SAVE_REPORT_127()
Dim wSheet, SheetsService As Worksheet
Dim i, j, rowFirst, rowLast, colFirst, colLast, fieldsCount, lRazdel, lRazdelCount, lNum As Integer
Dim lCell As Range
Dim fieldsArray(), typeArray(), lRazdelList(), lFieldsArr(), lFieldsTypeArr(), lFieldsNumList() As String
Dim tempStr  As String
Dim tempStr1 As String
Dim tabName, cSql, lFieldsList As String
Dim oRecordSet As Object
    
    cSql = ""
    On Error GoTo doError
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set SheetsService = Application.ActiveWorkbook.Sheets("Service")
    On Error GoTo 0
    Application.StatusBar = "Подождите... Идет подготовка к сохранению данных... "
    On Error GoTo ttt
    If oAdoConnect Is Nothing Then
        Call AdoSrvConnect
    End If
    GoTo lll
ttt:
lll:
    tabName = "##simply" + VBA.Trim(VBA.str(SheetsService.Range("A20"))) 'создаем табличку
    cSql = "IF not object_id(''tempdb.." + tabName + "'') is null DROP TABLE " + tabName + "  CREATE TABLE " + tabName + "(" + SheetsService.Range("A12").Text + ", ROW_ID INT, razdel int)"
    oAdoConnect.Execute ("A_EXEC '" + cSql + "'")
    lRazdelCount = SheetsService.Range("A11")
    ReDim lRazdelList(lRazdelCount)
    SheetsService.Visible = True
    tempStr = SheetsService.Range("A14")
    For i = 1 To SheetsService.Range("A11")
        lRazdelList(i) = getNextSubstr(tempStr, "|")
    Next
    tempStr = SheetsService.Range("A12")
    ReDim lFieldsArr(chr_count(tempStr, ",") + 1)
    ReDim lFieldsTypeArr(chr_count(tempStr, ",") + 1)
    For i = 1 To chr_count(tempStr, ",") + 1
        tempStr1 = getNextSubstr(tempStr, ",")
        lFieldsArr(i) = getNextSubstr(tempStr1, " ")
        lFieldsTypeArr(i) = getNextSubstr(tempStr1, " ")
    Next
    ReDim lFieldsNumList(lRazdelCount)
    tempStr = SheetsService.Range("A13")
    For i = 1 To lRazdelCount
        lFieldsNumList(i) = getNextSubstr(tempStr, "|")
    Next
    cSql = ""
    'найдем область данных (незащищенные ячейки)
    For lRazdel = 1 To lRazdelCount
        Sheets(lRazdelList(lRazdel)).Select
        Set wSheet = Application.ActiveWorkbook.ActiveSheet
        rowFirst = 0
        rowLast = 0
        Set lCell = StringFunc.LastCell(wSheet.Cells)
        For i = 1 To lCell.row
            If Not wSheet.Cells(i, 2).Locked And rowFirst = 0 Then rowFirst = i
            If wSheet.Cells(i, 2).Locked And rowFirst <> 0 And rowLast = 0 Then rowLast = i - 1
        Next
        
        colFirst = 0
        colLast = 0
        For i = 1 To lCell.column + 1
            If Not wSheet.Cells(rowFirst, i).Locked And colFirst = 0 Then colFirst = i
            If wSheet.Cells(rowFirst, i).Locked And colFirst <> 0 And colLast = 0 Then colLast = i - 1
        Next
     
        fieldsCount = chr_count(lFieldsNumList(lRazdel), ",") + 1
        ReDim fieldsArray(fieldsCount)
        ReDim typeArray(fieldsCount)
        
        tempStr = lFieldsNumList(lRazdel) + ", "
        lFieldsList = "row_id, razdel"
        For i = 1 To fieldsCount
            lNum = VBA.Int(VBA.Val(getNextSubstr(tempStr, ",")))
            fieldsArray(i) = lFieldsArr(lNum)
            typeArray(i) = lFieldsTypeArr(lNum)
            lFieldsList = lFieldsList + ", " + lFieldsArr(lNum)
        Next
        Application.StatusBar = "Подождите... Идет перенос данных на сервер... "
    
        For i = rowFirst To rowLast
            cSql = cSql + " INSERT " + tabName + "(" + lFieldsList + ") VALUES (" + str(i) + ", " + str(lRazdel) + ", "
            For j = 1 To fieldsCount
                If VBA.Left(VBA.UCase(typeArray(j)), 7) = "NUMERIC" Or VBA.UCase(typeArray(j)) = "MONEY" Or VBA.UCase(typeArray(j)) = "INT" Then
                    If IsNumeric(wSheet.Cells(i, colFirst + j - 1).Value) Then
                        cSql = cSql + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                    Else
                        If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                            cSql = cSql + "NULL"
                        Else
                            Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                            wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                            wSheet.Cells(i, colFirst + j - 1).Select
                            GoTo exitFunc
                        End If
                    End If
                Else
                    If VBA.Left(VBA.UCase(typeArray(j)), 7) = "VARCHAR" Then
                        cSql = cSql + "CONVERT(" + typeArray(j) + ",''" + Replace_in_Str(wSheet.Cells(i, colFirst + j - 1).Text, "'", """") + "'')"
                    Else
                        If VBA.Left(VBA.UCase(typeArray(j)), 8) = "DATETIME" Then
                            If IsDate(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                cSql = cSql + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                            Else
                                If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                    cSql = cSql + "NULL"
                                Else
                                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется дата", vbCritical, "Внимание, сохранение не произведено!")
                                    wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                                    wSheet.Cells(i, colFirst + j - 1).Select
                                    GoTo exitFunc
                                End If
                            End If
                        Else
                            Call MsgBox("Неопределенный тип поля " + typeArray(j), vbCritical, "Ошибка !")
                        End If
                    End If
                End If
                If j <> fieldsCount Then cSql = cSql + ", "
            Next
            cSql = cSql + ") "
            If VBA.Len(cSql) > 5000 Then
                oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
                cSql = ""
            End If
        Next
    Next
    If cSql <> "" Then
        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
    End If
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    If SheetsService.Range("A17").Text <> "" Then
        Set oRecordSet = CreateObject("ADODB.RecordSet")
        oRecordSet.Open SheetsService.Range("A17"), oAdoConnect, 2, 1, 1
        While Not oRecordSet.EOF
            Sheets(lRazdelList(oRecordSet.Fields("razdel"))).Cells(oRecordSet.Fields("row_id"), 2).Interior.color = RGB(255, 0, 0)
            oRecordSet.MoveNext
            Call MsgBox("Обнаружена ячейка с кодом, отсутствующем в справочнике!", vbCritical, "Внимание, сохранение произведено не корректно!")
        Wend
        oRecordSet.Close
        Set oRecordSet = Nothing
    End If
    If SheetsService.Range("A16").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A16"))
    End If
    If SheetsService.Range("A15").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A15"))
    End If
    Application.StatusBar = False
exitFunc:
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура сохранения 0503110
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Sub SAVE_REPORT()
Dim wSheet, SheetsService As Worksheet
Dim i, j, rowFirst, rowLast, colFirst, colLast, fieldsCount, lRazdel, lRazdelCount, lNum As Integer
Dim lCell As Range
Dim fieldsArray(), typeArray(), lRazdelList(), lFieldsArr(), lFieldsTypeArr(), lFieldsNumList() As String
Dim tempStr  As String
Dim tempStr1 As String
Dim tabName, cSql, lFieldsList As String
Dim oRecordSet As Object
    
    cSql = ""
    On Error GoTo doError
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set SheetsService = Application.ActiveWorkbook.Sheets("Service")
    Set lCell = StringFunc.LastCell(wSheet.Cells)
    On Error GoTo 0
    Application.StatusBar = "Подождите... Идет подготовка к сохранению данных... "
    'найдем область данных (незащищенные ячейки)
    rowFirst = 0
    rowLast = 0
    For i = 1 To lCell.row
        If (Not wSheet.Cells(i, 1).Locked Or Not wSheet.Cells(i, 2).Locked Or Not wSheet.Cells(i, 3).Locked) And rowFirst = 0 Then rowFirst = i
        If wSheet.Cells(i, 1).Locked And wSheet.Cells(i, 2).Locked And wSheet.Cells(i, 3).Locked And rowFirst <> 0 And rowLast = 0 Then rowLast = i - 1
    Next
    
    colFirst = 0
    colLast = 0
    For i = 1 To lCell.column + 1
        If Not wSheet.Cells(rowFirst, i).Locked And colFirst = 0 Then colFirst = i
        If wSheet.Cells(rowFirst, i).Locked And colFirst <> 0 And colLast = 0 Then colLast = i - 1
    Next
 
    fieldsCount = chr_count(SheetsService.Range("A9"), ",") + 1
    ReDim fieldsArray(fieldsCount)
    ReDim typeArray(fieldsCount)
    
    tempStr = SheetsService.Range("A9")
    For i = 1 To fieldsCount
        fieldsArray(i) = getNextSubstr(tempStr, ",")
    Next
    
    tempStr = SheetsService.Range("A10")
    For i = 1 To fieldsCount
        typeArray(i) = getNextSubstr(tempStr, ",")
    Next
    On Error GoTo ttt
    If oAdoConnect Is Nothing Then
        Call AdoSrvConnect
    End If
    GoTo lll
ttt:
lll:
    Application.StatusBar = "Подождите... Идет перенос данных на сервер... "
    tabName = "##simply" + VBA.Trim(VBA.str(SheetsService.Range("A20")))
    cSql = "IF not object_id(''tempdb.." + tabName + "'') is null DROP TABLE " + tabName + "  CREATE TABLE " + tabName + "(row_id int, "
    For i = 1 To fieldsCount
        cSql = cSql + fieldsArray(i) + " " + typeArray(i) + IIf(i <> fieldsCount, ", ", "")
    Next
    cSql = cSql + ")"
    oAdoConnect.Execute ("A_EXEC '" + cSql + "'")
    cSql = ""
    For i = rowFirst To rowLast
            cSql = cSql + " INSERT " + tabName + "(" + SheetsService.Range("A9") + ") VALUES ("
            For j = 1 To fieldsCount
                If VBA.Left(VBA.UCase(typeArray(j)), 7) = "NUMERIC" Or VBA.UCase(typeArray(j)) = "MONEY" Or VBA.UCase(typeArray(j)) = "INT" Then
                    If IsNumeric(wSheet.Cells(i, colFirst + j - 1).Value) Then
                        cSql = cSql + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                    Else
                        If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                            cSql = cSql + "NULL"
                        Else
                            Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                            wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                            wSheet.Cells(i, colFirst + j - 1).Select
                            GoTo exitFunc
                        End If
                    End If
                Else
                    If VBA.Left(VBA.UCase(typeArray(j)), 7) = "VARCHAR" Then
                        cSql = cSql + "CONVERT(" + typeArray(j) + ",''" + Replace_in_Str(wSheet.Cells(i, colFirst + j - 1).Text, "'", """") + "'')"
                    Else
                        If VBA.Left(VBA.UCase(typeArray(j)), 8) = "DATETIME" Then
                            If IsDate(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                cSql = cSql + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                            Else
                                If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                    cSql = cSql + "NULL"
                                Else
                                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется дата", vbCritical, "Внимание, сохранение не произведено!")
                                    wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                                    wSheet.Cells(i, colFirst + j - 1).Select
                                    GoTo exitFunc
                                End If
                            End If
                        Else
                            Call MsgBox("Неопределенный тип поля " + typeArray(j), vbCritical, "Ошибка !")
                        End If
                    End If
                End If
                If j <> fieldsCount Then cSql = cSql + ", "
            Next
            cSql = cSql + ") "
            If VBA.Len(cSql) > 5000 Then
                oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
                cSql = ""
            End If
    Next
    If cSql <> "" Then
        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
    End If
     If VBA.Right(SheetsService.Range("A3").Value, 5) = "_OVR3" Or VBA.Right(SheetsService.Range("A3").Value, 5) = "_OVR2" Or VBA.Right(SheetsService.Range("A3").Value, 5) = "_OVR4" Or VBA.Right(SheetsService.Range("A3").Value, 5) = "_OVR6" Then
         cSql = " UPDATE " + tabName + " SET f00 = case when len(f00)>1 then convert(varchar(1),LEFT(f00,1))+''0'' else ''1''+convert(varchar(1),ASCII(LEFT(f01,1))-223) end "
       oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
    End If
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    If SheetsService.Range("A17").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A17"))
    End If
    If SheetsService.Range("A16").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A16"))
    End If
    If SheetsService.Range("A15").Text <> "" Then
        oAdoConnect.Execute (SheetsService.Range("A15"))
    End If
        Application.StatusBar = False
exitFunc:
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура сохранения
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Sub SAVE_REPORT_1()
Dim wSheet, SheetsService As Worksheet
Dim i, j, rowFirst, rowLast, colFirst, colLast, fieldsCount, lRazdel, lRazdelCount, lNum As Integer
Dim lCell As Range
Dim fieldsArray(), typeArray(), lRazdelList(), lFieldsArr(), lFieldsTypeArr(), lFieldsNumList() As String
Dim tempStr  As String
Dim tempStr1 As String
Dim tabName, cSql, lFieldsList As String
Dim oRecordSet As Object
   
    cSql = ""
    On Error GoTo doError
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set SheetsService = Application.ActiveWorkbook.Sheets("Service")
    Set lCell = StringFunc.LastCell(wSheet.Cells)
    On Error GoTo 0
    Application.StatusBar = "Подождите... Идет подготовка к сохранению данных... "
    'найдем область данных (незащищенные ячейки)
    rowFirst = 0
    rowLast = 0
    For i = 1 To lCell.row
        If Not wSheet.Cells(i, 1).Locked And rowFirst = 0 Then rowFirst = i
        If wSheet.Cells(i, 1).Locked And rowFirst <> 0 And rowLast = 0 Then rowLast = i - 1
    Next
    
    colFirst = 0
    colLast = 0
    For i = 1 To lCell.column + 1
        If Not wSheet.Cells(rowFirst, i).Locked And colFirst = 0 Then colFirst = i
        If wSheet.Cells(rowFirst, i).Locked And colFirst <> 0 And colLast = 0 Then colLast = i - 1
    Next
    
    fieldsCount = chr_count(SheetsService.Range("A9"), ",") + 1
    ReDim fieldsArray(fieldsCount)
    ReDim typeArray(fieldsCount)
    
    tempStr = SheetsService.Range("A9")
    For i = 1 To fieldsCount
        fieldsArray(i) = getNextSubstr(tempStr, ",")
    Next
    
    tempStr = SheetsService.Range("A10")
    For i = 1 To fieldsCount
        typeArray(i) = getNextSubstr(tempStr, ",")
    Next
    On Error GoTo ttt
    If oAdoConnect Is Nothing Then
        Call AdoSrvConnect
    End If
    GoTo lll
ttt:
lll:
    Application.StatusBar = "Подождите... Идет перенос данных на сервер... "
    tabName = "##simply" + VBA.Trim(VBA.str(SheetsService.Range("A20")))
    
    cSql = "CREATE TABLE " + tabName + "("
    For i = 1 To fieldsCount
        cSql = cSql + fieldsArray(i) + " " + typeArray(i) + IIf(i <> fieldsCount, ", ", "")
    Next
    cSql = cSql + ")"
    oAdoConnect.Execute "A_EXEC '" + cSql + "'", 2048
    cSql = ""
    For i = rowFirst To rowLast
        cSql = cSql + " INSERT " + tabName + "(" + SheetsService.Range("A9") + ") VALUES ("
        For j = 1 To fieldsCount
            If VBA.Left(VBA.UCase(typeArray(j)), 7) = "NUMERIC" Or VBA.UCase(typeArray(j)) = "MONEY" Or VBA.UCase(typeArray(j)) = "INT" Then
                If IsNumeric(wSheet.Cells(i, colFirst + j - 1).Value) Then
                    cSql = cSql + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                        cSql = cSql + "NULL"
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                        wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + j - 1).Select
                        GoTo exitFunc
                    End If
                End If
            Else
                If VBA.Left(VBA.UCase(typeArray(j)), 7) = "VARCHAR" Then
                    cSql = cSql + "CONVERT(" + typeArray(j) + ",''" + Replace_in_Str(wSheet.Cells(i, colFirst + j - 1).Text, "'", """") + "'')"
                Else
                    If VBA.Left(VBA.UCase(typeArray(j)), 8) = "DATETIME" Then
                        If IsDate(wSheet.Cells(i, colFirst + j - 1).Value) Then
                            cSql = cSql + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                        Else
                            If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                cSql = cSql + "NULL"
                            Else
                                Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется дата", vbCritical, "Внимание, сохранение не произведено!")
                                wSheet.Cells(i, colFirst + j - 1).Interior.color = RGB(255, 0, 0)
                                wSheet.Cells(i, colFirst + j - 1).Select
                                GoTo exitFunc
                            End If
                        End If
                    Else
                        Call MsgBox("Неопределенный тип поля " + typeArray(j), vbCritical, "Ошибка !")
                    End If
                End If
            End If
            If j <> fieldsCount Then cSql = cSql + ", "
        Next
        cSql = cSql + ") "
        If VBA.Len(cSql) > 5000 Then
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + cSql + " '")
            cSql = ""
        End If
    Next
    If cSql <> "" Then
        oAdoConnect.Execute "EXECUTE A_EXEC ' " + cSql + " '", 2048
    End If
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    oAdoConnect.Execute ("V_SAVE_SIMPLY 1, '" + VBA.Format(SheetsService.Range("A1"), "yyyymmdd") + "','" + VBA.Format(SheetsService.Range("A2"), "yyyymmdd") + "','" + tabName + "', '" + SheetsService.Range("A3").Text + "', " + VBA.str(SheetsService.Range("A7").Value) + ",'" + SheetsService.Range("A9").Text + "'")
    Application.StatusBar = False
exitFunc:
    Set pnwrkConnect = Nothing
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура иницилизации панели инструментов
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Public Function init_Form_Toolbar(s As String) As Integer
    Set ToolbarAction = CommandBars("Меню SQL")
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
         .FaceId = 313
         .Style = msoButtonIcon
         .Caption = "Пересчитать по формулам"
         .OnAction = "CALC_REPORT_" + s
    End With
    
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
         .FaceId = 459
         .Style = msoButtonIcon
         .Caption = "Пересчитать по формулам"
         .OnAction = "CONTROL_REPORT_" + s
    End With
End Function
'---------------------------------------------------------------------------------------------------------------
' Процедура запуска расчета
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub CALC_REPORT_F607()
    Call REPORT_F607(1)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура запуска контроля
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub CONTROL_REPORT_F607()
    Call REPORT_F607(2)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура запуска расчета
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub CALC_REPORT_F6071()
    Call REPORT_F607(1, 1)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура запуска контроля
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub CONTROL_REPORT_F6071()
    Call REPORT_F607(2, 1)
End Sub
'---------------------------------------------------------------------------------------------------------------
' Процедура пересчета по формулам
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub REPORT_F607(mode As Integer, Optional lMode As Integer = 0)
Dim i As Integer, j As Integer, row8900000 As Integer, row1020111 As Integer, rowFirst As Integer, rowLast As Integer, colFirst As Integer, colLast As Integer
Dim lCell, wSheet, addCond As String, tmpStr As String, tmpDouble As Currency, errFlag As Boolean

    ' найдем область данных (незащищенные ячейки)
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set lCell = StringFunc.LastCell(wSheet.Cells)
    
    rowFirst = 0
    rowLast = 0
    row8900000 = 0
    row1020111 = 0
    errFlag = False
    For i = 1 To lCell.row
        If Not wSheet.Cells(i, 1).Locked Then
            If rowFirst = 0 Then rowFirst = i
            If wSheet.Cells(i, 1) = "00089000000000000000" Then row8900000 = i
            If wSheet.Cells(i, 1) = "1020111" Then row1020111 = i
        End If
        If wSheet.Cells(i, 1).Locked And rowFirst <> 0 And rowLast = 0 Then rowLast = i - 1
    Next

    colFirst = 0
    colLast = 0
    For i = 1 To lCell.column + 1
        If Not wSheet.Cells(rowFirst, i).Locked And colFirst = 0 Then colFirst = i
        If wSheet.Cells(rowFirst, i).Locked And colFirst <> 0 And colLast = 0 Then colLast = i - 1
    Next
    
    For i = rowFirst To rowLast
        For j = colFirst To colLast
            If Not wSheet.Cells(i, j).Comment Is Nothing Then wSheet.Cells(i, j).ClearComments
            wSheet.Cells(i, j).Interior.ColorIndex = xlNone
        Next
    Next
    
    
    If row8900000 <> 0 Then
        For i = 2 To colLast
            If row1020111 <> 0 Then
                addCond = "-" + wSheet.Cells(row1020111, i).Address
            Else
                addCond = ""
            End If
            
            If mode = 2 Then
                tmpStr = wSheet.Cells(row8900000, i).FormulaLocal
                tmpDouble = wSheet.Cells(row8900000, i).Value
            End If
            
            wSheet.Cells(row8900000, i).FormulaLocal = "=СУММ(" + wSheet.Cells(rowFirst, i).Address + ":" + wSheet.Cells(row8900000 - 1, i).Address + ")" + addCond
            
            If mode = 2 Then
                If Abs(tmpDouble - wSheet.Cells(row8900000, i).Value) > 0.001 Then
                    If wSheet.Cells(row8900000, i).Comment Is Nothing Then wSheet.Cells(row8900000, i).AddComment
                    wSheet.Cells(row8900000, i).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(row8900000, i).Value) + vbLf + wSheet.Cells(row8900000, i).Comment.Text)
                    wSheet.Cells(row8900000, i).Interior.ColorIndex = 3
                    errFlag = True
                End If
                wSheet.Cells(row8900000, i).FormulaLocal = tmpStr
            End If
        Next
    Else
        Call MsgBox("Отсутствует код 8900000", vbCritical)
    End If
    
    For i = rowFirst To rowLast
            If mode = 2 Then
                tmpStr = wSheet.Cells(i, 2).FormulaLocal
                tmpDouble = wSheet.Cells(i, 2).Value
            End If
            If lMode = 0 Then
                wSheet.Cells(i, 2).FormulaLocal = "=" + wSheet.Cells(i, 3).Address + "-" + wSheet.Cells(i, 4).Address + "+" + wSheet.Cells(i, 5).Address + "+" + wSheet.Cells(i, 6).Address + "+" + wSheet.Cells(i, 7).Address + "+" + wSheet.Cells(i, 8).Address + "+" + wSheet.Cells(i, 9).Address + "+" + wSheet.Cells(i, 10).Address + "+" + wSheet.Cells(i, 11).Address
            Else
                wSheet.Cells(i, 2).FormulaLocal = "=" + wSheet.Cells(i, 3).Address + "-" + wSheet.Cells(i, 4).Address + "+" + wSheet.Cells(i, 5).Address + "+" + wSheet.Cells(i, 6).Address + "+" + wSheet.Cells(i, 7).Address + "+" + wSheet.Cells(i, 8).Address + "+" + wSheet.Cells(i, 9).Address
            End If

            If mode = 2 Then
                If Abs(tmpDouble - wSheet.Cells(i, 2).Value) > 0.001 Then
                    If wSheet.Cells(i, 2).Comment Is Nothing Then wSheet.Cells(i, 2).AddComment
                    wSheet.Cells(i, 2).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(i, 2).Value) + vbLf + wSheet.Cells(i, 2).Comment.Text)
                    wSheet.Cells(i, 2).Interior.ColorIndex = 3
                    errFlag = True
                End If
                wSheet.Cells(i, 2).FormulaLocal = tmpStr
            End If
        
            If lMode = 1 And mode = 2 Then
                tmpStr = wSheet.Cells(i, 10).FormulaLocal
                tmpDouble = wSheet.Cells(i, 10).Value

                wSheet.Cells(i, 10).FormulaLocal = "=" + wSheet.Cells(i, 3).Address + "-" + wSheet.Cells(i, 4).Address + "-" + wSheet.Cells(i, 11).Address + "-" + wSheet.Cells(i, 12).Address + "-" + wSheet.Cells(i, 13).Address + "-" + wSheet.Cells(i, 14).Address + "-" + wSheet.Cells(i, 15).Address

                If Abs(tmpDouble - wSheet.Cells(i, 10).Value) > 0.001 Then
                    If wSheet.Cells(i, 10).Comment Is Nothing Then wSheet.Cells(i, 10).AddComment
                    wSheet.Cells(i, 10).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(i, 10).Value) + vbLf + wSheet.Cells(i, 10).Comment.Text)
                    wSheet.Cells(i, 10).Interior.ColorIndex = 3
                    errFlag = True
                End If
                wSheet.Cells(i, 10).FormulaLocal = tmpStr

            End If
    Next
    
    If mode = 2 And errFlag = True Then
        Call MsgBox("Обнаружены ошибки !!!", vbCritical, "Контроль по формулам")
    End If
    If mode = 2 And errFlag = False Then
        Call MsgBox("Ошибок не обнаружено !!!", vbOKOnly, "Контроль по формулам")
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub CALC_REPORT_F611()
    Call REPORT_F611(1)
End Sub
'---------------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub CONTROL_REPORT_F611()
    Call REPORT_F611(2)
End Sub
'---------------------------------------------------------------------------------------------------------------
' EdiS\07.10.10\bugs-16042
'---------------------------------------------------------------------------------------------------------------
Sub REPORT_F611(mode As Integer)
Dim i As Integer, j As Integer, row8200000 As Integer, row8900000 As Integer, row1020111 As Integer, rowFirst As Integer, rowLast As Integer, colFirst As Integer, colLast As Integer
Dim lCell, wSheet, addCond As String, tmpStr As String, tmpDouble As Currency, errFlag As Boolean

    ' найдем область данных (незащищенные ячейки)
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set lCell = StringFunc.LastCell(wSheet.Cells)
    
    rowFirst = 0
    rowLast = 0
    row8200000 = 0
    row8900000 = 0
    row1020111 = 0
    errFlag = False
    For i = 1 To lCell.row
        If Not wSheet.Cells(i, 2).Locked Then
            If rowFirst = 0 Then rowFirst = i
            If wSheet.Cells(i, 2) = "8200000" Then row8200000 = i
            If wSheet.Cells(i, 2) = "8900000" Then row8900000 = i
            If wSheet.Cells(i, 2) = "1020111" Then row1020111 = i
        End If
        If wSheet.Cells(i, 2).Locked And rowFirst <> 0 And rowLast = 0 Then rowLast = i - 1
    Next

    colFirst = 0
    colLast = 0
    For i = 1 To lCell.column + 1
        If Not wSheet.Cells(rowFirst, i).Locked And colFirst = 0 Then colFirst = i
        If wSheet.Cells(rowFirst, i).Locked And colFirst <> 0 And colLast = 0 Then colLast = i - 1
    Next
    
    For i = rowFirst To rowLast
        For j = colFirst To colLast
            If Not wSheet.Cells(i, j).Comment Is Nothing Then wSheet.Cells(i, j).ClearComments
            wSheet.Cells(i, j).Interior.ColorIndex = xlNone
        Next
    Next
    
    If row8200000 <> 0 Then
        For i = 3 To colLast
            If row1020111 <> 0 Then
                addCond = "-" + wSheet.Cells(row1020111, i).Address
            Else
                addCond = ""
            End If
            
            If mode = 2 Then
                tmpStr = wSheet.Cells(row8200000, i).FormulaLocal
                tmpDouble = wSheet.Cells(row8200000, i).Value
            End If
            
            wSheet.Cells(row8200000, i).FormulaLocal = "=СУММ(" + wSheet.Cells(rowFirst, i).Address + ":" + wSheet.Cells(row8200000 - 1, i).Address + ")" + addCond
            
            If mode = 2 Then
                If Abs(tmpDouble - wSheet.Cells(row8200000, i).Value) > 0.001 Then
                    If wSheet.Cells(row8200000, i).Comment Is Nothing Then wSheet.Cells(row8200000, i).AddComment
                    wSheet.Cells(row8200000, i).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(row8200000, i).Value) + vbLf + wSheet.Cells(row8200000, i).Comment.Text)
                    wSheet.Cells(row8200000, i).Interior.ColorIndex = 3
                    errFlag = True
                End If
                wSheet.Cells(row8200000, i).FormulaLocal = tmpStr
            End If
        Next
        
    Else
        Call MsgBox("Отсутствует код 8200000", vbCritical)
    End If
    
    If row8900000 <> 0 Then
        For i = 3 To colLast
            
            If mode = 2 Then
                tmpStr = wSheet.Cells(row8900000, i).FormulaLocal
                tmpDouble = wSheet.Cells(row8900000, i).Value
            End If
            
            wSheet.Cells(row8900000, i).FormulaLocal = "=СУММ(" + wSheet.Cells(IIf(row8200000 = 0, rowFirst, row8200000), i).Address + ":" + wSheet.Cells(row8900000 - 1, i).Address + ")"
            
            If mode = 2 Then
                If Abs(tmpDouble - wSheet.Cells(row8900000, i).Value) > 0.001 Then
                    If wSheet.Cells(row8900000, i).Comment Is Nothing Then wSheet.Cells(row8900000, i).AddComment
                    wSheet.Cells(row8900000, i).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(row8900000, i).Value) + vbLf + wSheet.Cells(row8900000, i).Comment.Text)
                    wSheet.Cells(row8900000, i).Interior.ColorIndex = 3
                    errFlag = True
                End If
                wSheet.Cells(row8900000, i).FormulaLocal = tmpStr
            End If
        Next
        
        ' с последними строками
        If mode = 2 Then
            If Abs(wSheet.Cells(row8900000, 3).Value - wSheet.Cells(row8900000 + 1, 3).Value - wSheet.Cells(row8900000 + 2, 3).Value) > 0.001 Then
                If wSheet.Cells(row8900000, 3).Comment Is Nothing Then wSheet.Cells(row8900000, 3).AddComment
                wSheet.Cells(row8900000, 3).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(row8900000 + 1, 3).Value + wSheet.Cells(row8900000 + 2, 3).Value) + vbLf + wSheet.Cells(row8900000, 3).Comment.Text)
                wSheet.Cells(row8900000, 3).Interior.ColorIndex = 3
                errFlag = True
            End If

        End If
    Else
        Call MsgBox("Отсутствует код 8900000", vbCritical)
    End If
    
    If mode = 2 And errFlag = True Then
        Call MsgBox("Обнаружены ошибки !!!", vbCritical, "Контроль по формулам")
    End If
    If mode = 2 And errFlag = False Then
        Call MsgBox("Ошибок не обнаружено !!!", vbOKOnly, "Контроль по формулам")
    End If
End Sub
'---------------------------------------------------------------------------------------------------------------
