Attribute VB_Name = "service_n"
Option Explicit

Public pnUser, dbPath, dbName, pnLogin, pnParol, pndbNameSql, _
        pnwrkODBC, pnwrkConnect, pUser_id, ToolbarAction


Sub Server_Connect()
    
On Error GoTo doError
With Application.ActiveWorkbook.Sheets("Service")
	'EdiS 25.09.2008 A22=1 - Win, A22<>1 - sql
	if (.Range("A22") = 1)  then
		set pnwrkODBC    = CreateWorkspace("SQL","","", dbUseODBC)
		set pnwrkConnect = pnwrkODBC.OpenConnection("",0,,"ODBC;DRIVER=SQL Server;SERVER=" + .Range("A4") + ";DATABASE=" + .Range("A5") + ";")
	else
		set pnwrkODBC = CreateWorkspace("SQL",.Range("A6"), decode_psw(.Range("A8")), dbUseODBC)
		set pnwrkConnect = pnwrkODBC.OpenConnection("SQL_CONNECT",0, ,"ODBC;DRIVER={SQL Server};SERVER=" + .Range("A4") + ";DATABASE=" + .Range("A5") + ";UID=" + .Range("A6") + ";PWD=" + decode_psw(.Range("A8")) + ";DSN=")
	end if
	pnwrkConnect.QueryTimeout = 0
End With
Exit Sub
doError:
    Call ERROR_EVENT("Server_Connect")
End Sub

Function SqlRet(sqlStr) As Variant
Dim wrkResultSet As Recordset
    On Error Resume Next

    If pnwrkConnect = "" Then
        If Err.Number = 0 Then Set pnwrkConnect = Nothing Else Err.Number = 0
    End If
    
    If pnwrkConnect Is Nothing Then
        Call Server_Connect
    End If

    Set wrkResultSet = pnwrkConnect.OpenRecordset(sqlStr, dbOpenDynaset)
    If Err.Number <> 0 Then
       Call MsgBox("Ошибка при выполнении " + sqlStr, vbCritical, "Внимание!")
       SqlRet = 0
    Else
        SqlRet = wrkResultSet(wrkResultSet.Fields(0).Name).Value
    End If


    Set wrkResultSet = Nothing

End Function

Public Function init_data(Optional s As String = "SAVE_REPORT") As Integer
Dim sheetsService
Dim Found As Boolean, cbar As Object, lBook

    If exists_name("OBJ_CODE") Then
         Found = False
         For Each cbar In Application.CommandBars
             If cbar.Name = "Меню SQL" Then Found = True
         Next
         If Found Then Application.CommandBars("Меню SQL").Delete

         Set lBook = Workbooks(Replace_in_Str(Application.ActiveWorkbook.Name, ".htm", ""))
         Set sheetsService = Application.ActiveWorkbook.Sheets.Add
         With sheetsService
             .Name = "Service"
             .Visible = xlSheetVeryHidden '2
             .Range("B1") = 1 'mode
             .Range("A1") = lBook.Sheets("Данные").Range(lBook.Names("dDate1")).Value 'lBook.Range(lBook.Names("dDate1").value).value
             .Range("A2") = lBook.Sheets("Данные").Range(lBook.Names("dDate2")).Value 'lBook.Names("dDate2").value
             .Range("A3") = lBook.Sheets("Данные").Range(lBook.Names("OBJ_CODE")).Value 'lBook.Names("OBJ_CODE").value
             .Range("A4") = lBook.Sheets("Данные").Range(lBook.Names("SRV_NAME")).Value 'lBook.Names("SRV_NAME").value
             .Range("A5") = lBook.Sheets("Данные").Range(lBook.Names("DB_NAME")).Value 'lBook.Names("DB_NAME").value
             .Range("A6") = lBook.Sheets("Данные").Range(lBook.Names("DBUSER_NAME")).Value 'lBook.Names("DBUSER_NAME").value
             .Range("A7") = lBook.Sheets("Данные").Range(lBook.Names("CORR_IN")).Value 'lBook.Names("CORR_IN").value
             .Range("A8") = lBook.Sheets("Данные").Range(lBook.Names("CORR_OUT")).Value 'lBook.Names("CORR_OUT").value
             .Range("A9") = lBook.Sheets("Данные").Range(lBook.Names("FIELDS_LIST")).Value 'lBook.Names("FIELDS_LIST").value
             .Range("A10") = lBook.Sheets("Данные").Range(lBook.Names("FIELDS_LIST_TYPE")).Value 'lBook.Names("FIELDS_LIST_TYPE").value


             If exists_name("RAZDEL_COUNT") Then
                     .Range("A11") = lBook.Sheets("Данные").Range(lBook.Names("RAZDEL_COUNT")).Value
     '                .Range("A11") = lBook.Names("RAZDEL_COUNT").value
     '                .Range("A11") = .Range("A11").value
             End If

             If exists_name("FIELDS_LIST_1") Then
                     .Range("A12") = lBook.Sheets("Данные").Range(lBook.Names("FIELDS_LIST_1")).Value
     '                .Range("A12") = lBook.Names("FIELDS_LIST_1").value
     '                .Range("A12") = .Range("A12").value
             End If

             If exists_name("FIELDS_LIST_2") Then
                     .Range("A13") = lBook.Sheets("Данные").Range(lBook.Names("FIELDS_LIST_2")).Value
     '                .Range("A13") = lBook.Names("FIELDS_LIST_2").value
     '                .Range("A13") = .Range("A13").value
             End If

             If exists_name("FIELDS_LIST_3") Then
                     .Range("A14") = lBook.Sheets("Данные").Range(lBook.Names("FIELDS_LIST_3")).Value
     '                .Range("A14") = lBook.Names("FIELDS_LIST_3").value
     '                .Range("A14") = .Range("A14").value
             End If

             If exists_name("SAVE_PROC_1") Then
                     .Range("A15") = lBook.Sheets("Данные").Range(lBook.Names("SAVE_PROC_1")).Value
     '                .Range("A15") = lBook.Names("SAVE_PROC_1").value
     '                .Range("A15") = .Range("A15").value
             End If

             If exists_name("SAVE_PROC_2") Then
                     .Range("A16") = lBook.Sheets("Данные").Range(lBook.Names("SAVE_PROC_2")).Value
     '                .Range("A16") = lBook.Names("SAVE_PROC_2").value
     '                .Range("A16") = .Range("A16").value
             End If

             If exists_name("SAVE_PROC_3") Then
                     .Range("A17") = lBook.Sheets("Данные").Range(lBook.Names("SAVE_PROC_3")).Value
     '                .Range("A17") = lBook.Names("SAVE_PROC_3").value
     '                .Range("A17") = .Range("A17").value

             End If
         End With
    End If

    Set ToolbarAction = CommandBars.Add(Name:="Меню SQL", Position:=msoBarTop, Temporary:=True)
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
         .FaceId = 342
         .Style = msoButtonIcon
         .Caption = "Сохранить данные отчета на сервере"
         .OnAction = "SAVE_REPORT"
    End With
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
            .BeginGroup = True
            .FaceId = 142
            .Style = msoButtonIcon
            .Caption = "Открыть пользовательские расчетные листы"
            .OnAction = "OpenUserCalcSheets"
    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


'*****************************

Public Function init_dao() As Boolean
Dim i, flag As Boolean
Dim path, guid
Dim errorF As Boolean
    On Error Resume Next
    For Each i In Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References
        If VBA.UCase(i.Name) = "DAO" Then
            Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.Remove (i)
            Debug.Print "Разрегистрировано " + i.Name
        End If
    Next
    init_dao = False
    flag = False
    If Dir("C:\Program Files\Common Files\Microsoft Shared\dao\DAO360.DLL") <> "" Then
        Debug.Print "Попытка регистрации DAO360.DLL... "

        Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.AddFromFile ("C:\Program Files\Common Files\Microsoft Shared\dao\DAO360.DLL")
        For Each i In Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References
            If VBA.UCase(i.Name) = "DAO" Then GoTo www1
        Next
www1:
        If IsError(i.fullPath) Or IsError(i.guid) Or IsError(i.Description) Or i.isBroken = True Then
                flag = False
                Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.Remove (i)
                Debug.Print "Неудачная регистрация DAO360.DLL"
        Else
                flag = True
                Debug.Print "Успешная регистрация DAO360.DLL"
        End If
        Debug.Print
    End If
    If Not flag Then
        If Dir("C:\Program Files\Common Files\Microsoft Shared\dao\DAO2535.TLB") <> "" Then
            Debug.Print "Попытка регистрации DAO2535.TLB... "

            Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.AddFromFile ("C:\Program Files\Common Files\Microsoft Shared\dao\DAO2535.TLB")
            For Each i In Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References
                If VBA.UCase(i.Name) = "DAO" Then GoTo www2
            Next
www2:
            If IsError(i.fullPath) Or IsError(i.guid) Or IsError(i.Description) Or i.isBroken = True Then
                flag = False
                Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.Remove (i)
                Debug.Print "Неудачная регистрация DAO2535.TLB"
            Else
                flag = True
                Debug.Print "Успешная регистрация DAO2535.TLB"
            End If
        End If
    End If

    If Not flag Then
        Sheets("Service").Range("A59") = 1
        flag = False
        Call MsgBox("Ошибка при инициализации библиотеки DAO, сохранение невозможно ", vbCritical, "Внимание!")
    Else
        Sheets("Service").Range("A59") = 0
        flag = True
    End If

    init_dao = flag
    On Error GoTo 0
'Dim flag As Boolean, i
'On Error GoTo doError
'    flag = True
'    For Each i In Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References
'        If VBA.UCase(i.fullPath) = VBA.UCase("C:\Program Files\Common Files\Microsoft Shared\dao\DAO2535.TLB") Then
'            flag = False
'        End If
'    Next
'
'    If flag Then
'        If DIR("C:\Program Files\Common Files\Microsoft Shared\dao\DAO2535.TLB") <> "" Then
'            Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.AddFromFile ("C:\Program Files\Common Files\Microsoft Shared\dao\DAO2535.TLB")
'        Else
'            Call MsgBox("Отсутствует библиотека DAO, сохранение невозможно ", vbCritical, "Внимание!")
'        End If
'    End If
'    init_dao = True
'    Exit Function
'doError:
'    Call MsgBox("Ошибка при инициализации библиотеки DAO, сохранение невозможно ", vbCritical, "Внимание!")
'    init_dao = False
End Function

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

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

Public Sub UNLOCK_CELLS()
    'If checkDataString(ActiveCell.row) Then
    '    Application.ActiveWorkbook.ActiveSheet.Rows(ActiveCell.row).Delete
    'Else
    '    Call MsgBox("Строка не из блока данных! " + vbNewLine + "Для удаления используйте стандартные средства EXCEL", vbOKOnly + vbInformation, "Ошибка удаления строки")
    'End If
    
Dim i As Integer, key_word As String, begin_unlock As Integer, last_column As String, key_column As Integer, f As Integer, k As Integer, t As Integer, shir_max As Integer, ws As Worksheet, m As String, len_stolbec As Integer
Dim stolbec() As String, mass_dani() As String

For Each ws In Application.ActiveWorkbook.Worksheets
                ws.Activate
 For i = 1 To 10
 If Left(Cells(i, 1).Value, 9) = "startlist" Then
    key_word = Cells(i, 2).Value
    key_column = Cells(i, 3).Value
    begin_unlock = Cells(i, 4).Value
    last_column = Cells(i, 5).Value
 End If
 Next i
Next ws
For Each ws In Application.ActiveWorkbook.Worksheets
ws.Activate
    If Left(Cells(3, 1).Value, 9) <> "startlist" And ws.Name <> "Service" Then
        f = begin_unlock
        Cells(begin_unlock, key_column).Select
        i = begin_unlock
        Do While Cells(f, key_column).Value <> key_word
            i = i + 1
            f = f + 1
        Loop
    Range("A" + Trim(str(begin_unlock)) + ":" + last_column + Trim(str(i - 1))).Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    
        
    End If
    
 Next ws

End Sub

Public Sub SAVE_REPORT_xxx()
Dim wSheet As Worksheet, i As Integer, j As Integer, rowFirst As Integer, rowLast As Integer, _
    colFirst As Integer, colLast As Integer, lCell As Range, fieldsCount As Integer, _
    fieldsArray() As String, typeArray() As String, sheetsService As Worksheet, tempStr As String, _
    tabName As String, sqlStr As String, lRazdel As Integer, lRazdelList() As String, lFieldsArr() As String, lFieldsTypeArr() As String, lFieldsNumList() As String, _
    tempStr1 As String, lRazdelCount As Integer, lNum As Integer, lFieldsList As String, wrkResultSet
    
'lRazdelList(lRazdel) = "1. Доходы бюджета (1)"
'lRazdelList(lRazdel) = "2. Расходы бюджета (1)"
'lRazdelList(lRazdel) = "3. Источники финансирования (1)"
   
    'lcLogFile = "c:\save.log"   ' файл статистики
    sqlStr = ""
    On Error GoTo doError
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    On Error GoTo 0
'    CALL PrintFile(lcLogFile, 0, "---------------------------------------------")
   ' Call PrintFile(lcLogFile, 0, "Сохранение документа: " + sheetsService.Range("A3").Text)

    Application.StatusBar = "Подождите... Идет подготовка к сохранению данных... "
    
    ' создаем табличку 
    tabName = "##simply" + VBA.Trim(VBA.STR(sheetsService.Range("A20")))+Right("00000" + Val(Int(100000 * Rnd())), 5)
    
    sqlStr = "IF not object_id(''tempdb.." + tabName + "'') is null DROP TABLE " + tabName + "  CREATE TABLE " + tabName + "(" + sheetsService.Range("A12").Text + ", ROW_ID INT, razdel int)"
    'Call PrintFile(lcLogFile, 1, "A_EXEC '" + sqlStr + "'")

    'подключаем DAO 2.5/3.5
    If Not testRef() Then 'init_dao
        Exit Sub
    End If
    Call Server_Connect

    pnwrkConnect.Execute "A_EXEC '" + sqlStr + "'", 2048
    
    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
    
    sqlStr = ""
    
' найдем область данных (незащищенные ячейки)
    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
            sqlStr = sqlStr + " 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
                        sqlStr = sqlStr + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                    Else
                        If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                            sqlStr = sqlStr + "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
                        sqlStr = sqlStr + "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
                                sqlStr = sqlStr + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                            Else
                                If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                    sqlStr = sqlStr + "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 sqlStr = sqlStr + ", "
            Next
            sqlStr = sqlStr + ") "
            
            ' Выполняем пакет команд
            If VBA.Len(sqlStr) > 5000 Then
                'Call PrintFile(lcLogFile, 1, "EXECUTE A_EXEC ' " + sqlStr + " '")
                pnwrkConnect.Execute "EXECUTE A_EXEC ' " + sqlStr + " '", 2048
                sqlStr = ""
            End If
            
        Next

    Next
    
    If sqlStr <> "" Then
        'Call PrintFile(lcLogFile, 1, "EXECUTE A_EXEC ' " + sqlStr + " '")
        pnwrkConnect.Execute "EXECUTE A_EXEC ' " + sqlStr + " '", 2048
    End If
    
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    If sheetsService.Range("A17").Text <> "" Then
        'Call PrintFile(lcLogFile, 1, sheetsService.Range("A17"))
        Set wrkResultSet = pnwrkConnect.OpenRecordset(sheetsService.Range("A17"), 2) 'dbOpenDynaset)
        While Not wrkResultSet.EOF
            Sheets(lRazdelList(wrkResultSet("razdel"))).Cells(wrkResultSet("row_id"), 2).Interior.color = RGB(255, 0, 0)
            Sheets(lRazdelList(wrkResultSet("razdel"))).Cells(wrkResultSet("row_id"), 3).Interior.color = RGB(255, 0, 0)
            wrkResultSet.MoveNext
            Call MsgBox("Обнаружена ячейка с кодом, отсутствующем в справочнике!", vbCritical, "Внимание, сохранение произведено не корректно!")
        Wend
        'pnwrkConnect.Execute sheetsService.Range("A17"), 2048 'dbExecDirect
    End If
    If sheetsService.Range("A16").Text <> "" Then
        'Call PrintFile(lcLogFile, 1, sheetsService.Range("A16"))
        pnwrkConnect.Execute sheetsService.Range("A16"), 2048 'dbExecDirect
    End If
    If sheetsService.Range("A15").Text <> "" Then
        'Call PrintFile(lcLogFile, 1, sheetsService.Range("A15"))
        pnwrkConnect.Execute sheetsService.Range("A15"), 2048 'dbExecDirect
    End If
    
    Application.StatusBar = False
exitFunc:
    Set pnwrkConnect = Nothing
    
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub
Sub OpenUserCalcSheets()


    Dim oPriWS As Worksheet, oSecWB As Workbook, oWS As Worksheet, cMess As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Interactive = False
    Application.Calculation = xlManual
    
    cMess = ""
    Set oPriWS = Application.ActiveSheet
    
    If Application.Dialogs(xlDialogOpen).Show Then
        Set oSecWB = Application.ActiveWorkbook
        If oPriWS.Parent.Sheets.count + oSecWB.Sheets.count <= 255 Then
            For Each oWS In oSecWB.Sheets
                If oWS.Visible = xlSheetVisible Then
                    oWS.Copy After:=oPriWS
                    cMess = cMess + VBA.vbNewLine + oWS.Name
                End If
            Next oWS
            If cMess <> "" Then
                cMess = "Из книги """ + oSecWB.Name + """ добавлены листы:" + cMess
            End If
        Else
            cMess = "Количество листов добавляемой книги """ + oSecWB.Name + """" + VBA.vbNewLine _
                + "превышает допустимый предел количества" + VBA.vbNewLine _
                + "в 255 листов на книгу. Листы не добавлены."
        End If
        oSecWB.Close SaveChanges:=False
        oPriWS.Activate
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Interactive = True

    If cMess <> "" Then
        Call VBA.MsgBox(cMess, VBA.vbOKOnly + VBA.vbInformation, "Внимание")
    End If
        UNLOCK_CELLS
End Sub

Public Sub SAVE_REPORT()
Dim wSheet As Worksheet, i As Integer, j As Integer, rowFirst As Integer, rowLast As Integer, _
    colFirst As Integer, colLast As Integer, lCell As Range, fieldsCount As Integer, _
    fieldsArray() As String, typeArray() As String, sheetsService As Worksheet, tempStr As String, _
    tabName As String, sqlStr As String
    
    'lcLogFile = "c:\save.log"   ' файл статистики
    'Stop
    sqlStr = ""
    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
'    CALL PrintFile(lcLogFile, 0, "---------------------------------------------")
    'Call PrintFile(lcLogFile, 0, "Сохранение документа: " + sheetsService.Range("A3").Text)

    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
'подключаем DAO 2.5/3.5
    If Not testRef() Then 'init_dao
        Exit Sub
    End If
    Call Server_Connect
    
    Application.StatusBar = "Подождите... Идет перенос данных на сервер... "
' создаем табличку 
    tabName = "##simply" + VBA.Trim(VBA.STR(sheetsService.Range("A20")))+Right("00000" + Val(Int(100000 * Rnd())), 5)
    
    sqlStr = "IF not object_id(''tempdb.." + tabName + "'') is null DROP TABLE " + tabName + "  CREATE TABLE " + tabName + "(row_id int, "
    For i = 1 To fieldsCount
        sqlStr = sqlStr + fieldsArray(i) + " " + typeArray(i) + IIf(i <> fieldsCount, ", ", "")
    Next
    sqlStr = sqlStr + ")"

    
    'Если это таблица сохранения данных по ссудным кредитам, то добавляем счетчик
    If sheetsService.Range("A3").Text = "ssuda_load" Then
        sqlStr = sqlStr + " ALTER TABLE " + tabName + " ADD [identity_id] int IDENTITY(1, 1) "
    End If		


    'Call PrintFile(lcLogFile, 1, "A_EXEC '" + sqlStr + "'")

    pnwrkConnect.Execute "A_EXEC '" + sqlStr + "'", 2048

    sqlStr = ""
    If sheetsService.Range("A3").Value = "DOCUMENTS_F663" Then
        Call Ins_Data_F663(wSheet, sheetsService, fieldsCount, tabName)
    Else
        For i = rowFirst To rowLast
            sqlStr = sqlStr + " 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
                        sqlStr = sqlStr + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                    Else
                        If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                            sqlStr = sqlStr + "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
                        sqlStr = sqlStr + "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
                                sqlStr = sqlStr + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                            Else
                                If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                    sqlStr = sqlStr + "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 sqlStr = sqlStr + ", "
            Next
            sqlStr = sqlStr + ") "
            
            ' Выполняем пакет команд
            If VBA.Len(sqlStr) > 5000 Then
                'Call PrintFile(lcLogFile, 1, "EXECUTE A_EXEC ' " + sqlStr + " '")
                pnwrkConnect.Execute "EXECUTE A_EXEC ' " + sqlStr + " '", 2048
                sqlStr = ""
            End If
            
        Next
    End If
    
    If sqlStr <> "" Then
        'Call PrintFile(lcLogFile, 1, "EXECUTE A_EXEC ' " + sqlStr + " '")
        pnwrkConnect.Execute "EXECUTE A_EXEC ' " + sqlStr + " '", 2048
    End If
    
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    If sheetsService.Range("A17").Text <> "" Then
        'Call PrintFile(lcLogFile, 1, sheetsService.Range("A17"))
        pnwrkConnect.Execute sheetsService.Range("A17"), 2048 'dbExecDirect
    End If
    If sheetsService.Range("A16").Text <> "" Then
        'Call PrintFile(lcLogFile, 1, sheetsService.Range("A16"))
        pnwrkConnect.Execute sheetsService.Range("A16"), 2048 'dbExecDirect
    End If
    If sheetsService.Range("A15").Text <> "" Then
        'Call PrintFile(lcLogFile, 1, sheetsService.Range("A15"))
        pnwrkConnect.Execute sheetsService.Range("A15"), 2048 'dbExecDirect
    End If
    
    Application.StatusBar = False
exitFunc:
    Set pnwrkConnect = Nothing
    
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub

Public Sub SAVE_REPORT_1()
Dim wSheet As Worksheet, i As Integer, j As Integer, rowFirst As Integer, rowLast As Integer, _
    colFirst As Integer, colLast As Integer, lCell As Range, fieldsCount As Integer, _
    fieldsArray() As String, typeArray() As String, sheetsService As Worksheet, tempStr As String, _
    tabName As String, sqlStr As String
    
    'lcLogFile = "c:\save.log"   ' файл статистики
    'Stop
    sqlStr = ""
    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
'    CALL PrintFile(lcLogFile, 0, "---------------------------------------------")
    'Call PrintFile(lcLogFile, 0, "Сохранение документа: " + sheetsService.Range("A3").Text)

    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
'подключаем DAO 2.5/3.5
    If Not init_dao Then
        Exit Sub
    End If
    Call Server_Connect
    
    Application.StatusBar = "Подождите... Идет перенос данных на сервер... "
' создаем табличку   
    tabName = "##simply" + VBA.Trim(VBA.STR(sheetsService.Range("A20")))+Right("00000" + Val(Int(100000 * Rnd())), 5)
    
    sqlStr = "CREATE TABLE " + tabName + "("
    For i = 1 To fieldsCount
        sqlStr = sqlStr + fieldsArray(i) + " " + typeArray(i) + IIf(i <> fieldsCount, ", ", "")
    Next
    sqlStr = sqlStr + ")"
    'Call PrintFile(lcLogFile, 1, "A_EXEC '" + sqlStr + "'")

    pnwrkConnect.Execute "A_EXEC '" + sqlStr + "'", 2048

    sqlStr = ""
    For i = rowFirst To rowLast
        sqlStr = sqlStr + " 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
                    sqlStr = sqlStr + VBA.str(wSheet.Cells(i, colFirst + j - 1).Value)
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                        sqlStr = sqlStr + "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
                    sqlStr = sqlStr + "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
                            sqlStr = sqlStr + "''" + Format(wSheet.Cells(i, colFirst + j - 1).Value, "yyyymmdd") + "''"
                        Else
                            If IsEmpty(wSheet.Cells(i, colFirst + j - 1).Value) Then
                                sqlStr = sqlStr + "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 sqlStr = sqlStr + ", "
        Next
        sqlStr = sqlStr + ") "
        
        ' Выполняем пакет команд
        If VBA.Len(sqlStr) > 5000 Then
            'Call PrintFile(lcLogFile, 1, "EXECUTE A_EXEC ' " + sqlStr + " '")
            pnwrkConnect.Execute "EXECUTE A_EXEC ' " + sqlStr + " '", 2048
            sqlStr = ""
        End If
        
    Next
    
    If sqlStr <> "" Then
        'Call PrintFile(lcLogFile, 1, "EXECUTE A_EXEC ' " + sqlStr + " '")
        pnwrkConnect.Execute "EXECUTE A_EXEC ' " + sqlStr + " '", 2048
    End If
    
    Application.StatusBar = "Подождите... Идет сохранение данных... "
    'Call PrintFile(lcLogFile, 1, "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 + "'")
    pnwrkConnect.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 + "'", 2048 'dbExecDirect
    Application.StatusBar = False
exitFunc:
    Set pnwrkConnect = Nothing
    
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
    Exit Sub
doError:
    Call MsgBox("Ошибка при сохранении данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим сохранения данных на сервере", vbCritical, "Ошибка !")
End Sub

Sub PrintFile(lcFile As String, lnMode As Integer, lcStr As String)
    If lcFile = "" Then Exit Sub
    If lnMode = 0 Then
        Open lcFile For Output As #1
    Else
        Open lcFile For Append As #1
    End If
    Print #1, lcStr
    Close #1
End Sub

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

Sub CALC_REPORT_F607()
    Call REPORT_F607(1)
End Sub

Sub CONTROL_REPORT_F607()
    Call REPORT_F607(2)
End Sub

Sub CALC_REPORT_F6071()
    Call REPORT_F607(1, 1)
End Sub

Sub CONTROL_REPORT_F6071()
    Call REPORT_F607(2, 1)
End Sub


Sub test()
Dim d As Currency
d = ActiveSheet.Range("B187").Value
End Sub

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
        
        ' с последними строками
'        If mode = 2 Then
'            If Abs(wSheet.Cells(row8900000, 13).Value - wSheet.Cells(row8900000 + 1, 13).Value - wSheet.Cells(row8900000 + 2, 13).Value) > 0.001 Then
'                If wSheet.Cells(row8900000, 13).Comment Is Nothing Then wSheet.Cells(row8900000, 13).AddComment
'                wSheet.Cells(row8900000, 13).Comment.Text ("Расчитано " + VBA.str(wSheet.Cells(row8900000 + 1, 13).Value + wSheet.Cells(row8900000 + 2, 13).Value) + vbLf + wSheet.Cells(row8900000, 13).Comment.Text)
'                wSheet.Cells(row8900000, 13).Interior.ColorIndex = 3
'                errFlag = True
'            End If
'
'            If Abs(wSheet.Cells(row8900000, 5).Value) > 0.001 Then
'                If wSheet.Cells(row8900000, 5).Comment Is Nothing Then wSheet.Cells(row8900000, 5).AddComment
'                wSheet.Cells(row8900000, 5).Comment.Text ("Должно быть 0!!!" + vbLf + wSheet.Cells(row8900000, 5).Comment.Text)
'                wSheet.Cells(row8900000, 5).Interior.ColorIndex = 3
'                errFlag = True
'            End If
'        End If
    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
                'гр.3 - гр.4 +гр.5 + гр.6 + гр.7+гр.8+гр.9+гр.10+гр.11
                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 'графа2 = графа3 -графа4+графа5+графа6+графа7+графа8+графа9
                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

Sub CALC_REPORT_F611()
    Call REPORT_F611(1)
End Sub

Sub CONTROL_REPORT_F611()
    Call REPORT_F611(2)
End Sub


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
'Палатов 11.03.2004 Процедура вставки данных в таблицу сохранения данных для формы 663
Sub Ins_Data_F663(p_wSheet As Worksheet, p_sheetsService As Worksheet, p_fieldsCount As Integer, p_tabName As String)
Dim P_Str As String, i As Integer, j As Integer, p_tempStr As String, p_razdel As Integer, p_num_kind As String, p_num_str As String, p_name_str As String, p_kod_ekl As String, p_num_reest As String, p_sum_pol As String, p_sum_isp As String, _
    p_sum_vozv As String, p_gsum_pol As String, p_gsum_isp As String, p_gsum_vozv As String, p_kod_str As String, p_num_pp As String, p_rowFirst As Integer, p_rowLast As Integer, p_colFirst As Integer, p_colLast As Integer, p_lCell As Range, _
    itog_1010_gp As Currency, itog_1020_gp As Currency, itog_1030_gp As Currency, itog_1040_gp As Currency, itog_1999_gp As Currency, itog_2010_gp As Currency, itog_2020_gp As Currency, itog_2030_gp As Currency, itog_2999_gp As Currency, _
    itog_1010_p As Currency, itog_1020_p As Currency, itog_1030_p As Currency, itog_1040_p As Currency, itog_1999_p As Currency, itog_2010_p As Currency, itog_2020_p As Currency, itog_2030_p As Currency, itog_2999_p As Currency, _
    itog_1010_gi As Currency, itog_1020_gi As Currency, itog_1030_gi As Currency, itog_1040_gi As Currency, itog_1999_gi As Currency, itog_2010_gi As Currency, itog_2020_gi As Currency, itog_2030_gi As Currency, itog_2999_gi As Currency, _
    itog_1010_i As Currency, itog_1020_i As Currency, itog_1030_i As Currency, itog_1040_i As Currency, itog_1999_i As Currency, itog_2010_i As Currency, itog_2020_i As Currency, itog_2030_i As Currency, itog_2999_i As Currency, _
    itog_1010_gv As Currency, itog_1020_gv As Currency, itog_1030_gv As Currency, itog_1040_gv As Currency, itog_1999_gv As Currency, itog_2010_gv As Currency, itog_2020_gv As Currency, itog_2030_gv As Currency, itog_2999_gv As Currency, _
    itog_1010_v As Currency, itog_1020_v As Currency, itog_1030_v As Currency, itog_1040_v As Currency, itog_1999_v As Currency, itog_2010_v As Currency, itog_2020_v As Currency, itog_2030_v As Currency, itog_2999_v As Currency
    P_Str = ""
    Set p_lCell = StringFunc.LastCell(p_wSheet.Cells)
   'найдем область данных (незащищенные ячейки)
    p_rowFirst = 0
    p_rowLast = 0
    itog_1010_gp = 0: itog_1020_gp = 0: itog_1030_gp = 0: itog_1040_gp = 0: itog_1999_gp = 0: itog_2010_gp = 0: itog_2020_gp = 0: itog_2030_gp = 0: itog_2999_gp = 0
    itog_1010_p = 0: itog_1020_p = 0: itog_1030_p = 0: itog_1040_p = 0: itog_1999_p = 0: itog_2010_p = 0: itog_2020_p = 0: itog_2030_p = 0: itog_2999_p = 0
    itog_1010_gi = 0: itog_1020_gi = 0: itog_1030_gi = 0: itog_1040_gi = 0: itog_1999_gi = 0: itog_2010_gi = 0: itog_2020_gi = 0: itog_2030_gi = 0: itog_2999_gi = 0
    itog_1010_i = 0: itog_1020_i = 0: itog_1030_i = 0: itog_1040_i = 0: itog_1999_i = 0: itog_2010_i = 0: itog_2020_i = 0: itog_2030_i = 0: itog_2999_i = 0
    itog_1010_gv = 0: itog_1020_gv = 0: itog_1030_gv = 0: itog_1040_gv = 0: itog_1999_gv = 0: itog_2010_gv = 0: itog_2020_gv = 0: itog_2030_gv = 0: itog_2999_gv = 0
    itog_1010_v = 0: itog_1020_v = 0: itog_1030_v = 0: itog_1040_v = 0: itog_1999_v = 0: itog_2010_v = 0: itog_2020_v = 0: itog_2030_v = 0: itog_2999_v = 0
    For i = 1 To p_lCell.row
        If Not p_wSheet.Cells(i, 1).Locked And p_rowFirst = 0 Then p_rowFirst = i
        If Not p_wSheet.Cells(i, 1).Locked And p_rowLast < i Then p_rowLast = i
    Next
    
    p_colFirst = 0
    p_colLast = 0
    For i = 1 To p_lCell.column + 1
        If Not p_wSheet.Cells(p_rowFirst, i).Locked And p_colFirst = 0 Then p_colFirst = i
        If p_wSheet.Cells(p_rowFirst, i).Locked And p_colFirst <> 0 And p_colLast = 0 Then p_colLast = i - 1
    Next
 
    ReDim p_fieldsArray(p_fieldsCount)
    ReDim p_typeArray(p_fieldsCount)
    
    p_tempStr = p_sheetsService.Range("A9")
    For i = 1 To p_fieldsCount
        p_fieldsArray(i) = getNextSubstr(p_tempStr, ",")
    Next
    
    p_tempStr = p_sheetsService.Range("A10")
    For i = 1 To p_fieldsCount
        p_typeArray(i) = getNextSubstr(p_tempStr, ",")
    Next
    p_razdel = 1
    p_num_kind = "0"
    p_kod_str = "1016"
    p_num_pp = ""

    For i = p_rowFirst To p_rowLast
        If Not p_wSheet.Cells(i, p_colFirst).Locked Then
            If IsEmpty(p_wSheet.Cells(i, p_colFirst).Value) Then
                p_num_str = ""
            Else
                p_num_str = p_wSheet.Cells(i, p_colFirst).Value
                'простановка кода строки и номера строки
                p_num_kind = VBA.Left(p_num_str, VBA.Len(p_num_str) - 1)
                Select Case p_num_kind
                Case "1"
                    If p_razdel = 1 Then
                        p_kod_str = "1016"
                    Else
                        p_kod_str = "2011"
                    End If
                Case "2"
                    If p_razdel = 1 Then
                        p_kod_str = "1011"
                    Else
                        p_kod_str = "2012"
                    End If
                Case "3"
                    If p_razdel = 1 Then
                        p_kod_str = "1012"
                    Else
                        p_kod_str = "2013"
                    End If
                Case "4"
                    If p_razdel = 1 Then
                        p_kod_str = "1013"
                    Else
                        p_kod_str = "2014"
                    End If
                Case "5"
                    If p_razdel = 1 Then
                        p_kod_str = "1014"
                    Else
                        p_kod_str = "2015"
                    End If
                Case "6"
                    If p_razdel = 1 Then
                        p_kod_str = "1015"
                    Else
                        p_kod_str = "2016"
                    End If
                Case "7"
                    If p_razdel = 1 Then
                        p_kod_str = "1030"
                    Else
                        p_kod_str = "2020"
                    End If
                Case "7.1"
                    p_kod_str = "2021"
                Case "7.2"
                    p_kod_str = "2022"
                Case "7.3"
                    p_kod_str = "2024"
                Case "8"
                    If p_razdel = 1 Then
                        p_kod_str = "1040"
                    Else
                        p_kod_str = "2030"
                    End If
                Case "9"
                   p_kod_str = "2040"
                Case Else
                    'p_kod_str = "1016"
                End Select
            End If
            If IsEmpty(p_wSheet.Cells(i, p_colFirst + 1).Value) Then
                p_name_str = ""
            Else
                p_name_str = p_wSheet.Cells(i, p_colFirst + 1).Value
            End If
            If IsEmpty(p_wSheet.Cells(i, p_colFirst + 2).Value) Then
                p_num_reest = ""
            Else
                p_num_reest = p_wSheet.Cells(i, p_colFirst + 2).Value
                If p_num_reest = "Итого по разделу 1901:" Then
                    p_kod_str = "1999"
                End If
                If p_num_reest = "Итого по коду 02002:" Then
                    p_kod_str = "2999"
                End If
            End If
            If IsEmpty(p_wSheet.Cells(i, p_colFirst + 3).Value) Then
                p_kod_ekl = ""
            Else
                p_kod_ekl = p_wSheet.Cells(i, p_colFirst + 3).Value
            End If
            'заполнение сумм
            If IsNumeric(p_wSheet.Cells(i, p_colFirst + 4).Value) Then
                p_gsum_pol = VBA.str(p_wSheet.Cells(i, p_colFirst + 4).Value)
            Else
                If IsEmpty(p_wSheet.Cells(i, p_colFirst + 4).Value) Then
                    p_gsum_pol = "0"
                Else
                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                    p_wSheet.Cells(i, p_colFirst + 4).Interior.color = RGB(255, 0, 0)
                    p_wSheet.Cells(i, p_colFirst + 4).Select
                    GoTo p_exitFunc
                End If
            End If
            If IsNumeric(p_wSheet.Cells(i, p_colFirst + 5).Value) Then
                p_sum_pol = VBA.str(p_wSheet.Cells(i, p_colFirst + 5).Value)
            Else
                If IsEmpty(p_wSheet.Cells(i, p_colFirst + 5).Value) Then
                    p_sum_pol = "0"
                Else
                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                    p_wSheet.Cells(i, p_colFirst + 5).Interior.color = RGB(255, 0, 0)
                    p_wSheet.Cells(i, p_colFirst + 5).Select
                    GoTo p_exitFunc
                End If
            End If
            If IsNumeric(p_wSheet.Cells(i, p_colFirst + 6).Value) Then
                p_gsum_isp = VBA.str(p_wSheet.Cells(i, p_colFirst + 6).Value)
            Else
                If IsEmpty(p_wSheet.Cells(i, p_colFirst + 6).Value) Then
                    p_gsum_isp = "0"
                Else
                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                    p_wSheet.Cells(i, p_colFirst + 6).Interior.color = RGB(255, 0, 0)
                    p_wSheet.Cells(i, p_colFirst + 6).Select
                    GoTo p_exitFunc
                End If
            End If
            If IsNumeric(p_wSheet.Cells(i, p_colFirst + 7).Value) Then
                p_sum_isp = VBA.str(p_wSheet.Cells(i, p_colFirst + 7).Value)
            Else
                If IsEmpty(p_wSheet.Cells(i, p_colFirst + 7).Value) Then
                    p_sum_isp = "0"
                Else
                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                    p_wSheet.Cells(i, p_colFirst + 7).Interior.color = RGB(255, 0, 0)
                    p_wSheet.Cells(i, p_colFirst + 7).Select
                    GoTo p_exitFunc
                End If
            End If
            If IsNumeric(p_wSheet.Cells(i, p_colFirst + 8).Value) Then
                p_gsum_vozv = VBA.str(p_wSheet.Cells(i, p_colFirst + 8).Value)
            Else
                If IsEmpty(p_wSheet.Cells(i, p_colFirst + 8).Value) Then
                    p_gsum_vozv = "0"
                Else
                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                    p_wSheet.Cells(i, p_colFirst + 8).Interior.color = RGB(255, 0, 0)
                    p_wSheet.Cells(i, p_colFirst + 8).Select
                    GoTo p_exitFunc
                End If
            End If
            If IsNumeric(p_wSheet.Cells(i, p_colFirst + 9).Value) Then
                p_sum_vozv = VBA.str(p_wSheet.Cells(i, p_colFirst + 9).Value)
            Else
                If IsEmpty(p_wSheet.Cells(i, p_colFirst + 9).Value) Then
                    p_sum_vozv = "0"
                Else
                    Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, сохранение не произведено!")
                    p_wSheet.Cells(i, p_colFirst + 9).Interior.color = RGB(255, 0, 0)
                    p_wSheet.Cells(i, p_colFirst + 9).Select
                    GoTo p_exitFunc
                End If
            End If
            'подсчет итоговых строчек
            Select Case p_kod_str
                Case "1011", "1012", "1013", "1014", "1015", "1016", "1017", "1018"
                    If p_num_reest = "x" Then
                        itog_1010_gp = itog_1010_gp + Val(p_gsum_pol): itog_1010_p = itog_1010_p + Val(p_sum_pol)
                        itog_1010_gi = itog_1010_gi + Val(p_gsum_isp): itog_1010_i = itog_1010_i + Val(p_sum_isp)
                        itog_1010_gv = itog_1010_gv + Val(p_gsum_vozv): itog_1010_v = itog_1010_v + Val(p_sum_vozv)
                    Else
                        'сбор обычных строчек
                    End If
                Case "2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018"
                    If p_num_reest = "x" Then
                        itog_2010_gp = itog_2010_gp + Val(p_gsum_pol): itog_2010_p = itog_2010_p + Val(p_sum_pol)
                        itog_2010_gi = itog_2010_gi + Val(p_gsum_isp): itog_2010_i = itog_2010_i + Val(p_sum_isp)
                        itog_2010_gv = itog_2010_gv + Val(p_gsum_vozv): itog_2010_v = itog_2010_v + Val(p_sum_vozv)
                    Else
                        'сбор обычных строчек
                    End If
            End Select
            'If p_num_reest = "x" Then
            '    Select Case p_razdel
            '        Case 1
            '            itog_1999_gp = itog_1999_gp + Val(p_gsum_pol): itog_1999_p = itog_1999_p + Val(p_sum_pol)
            '            itog_1999_gi = itog_1999_gi + Val(p_gsum_isp): itog_1999_i = itog_1999_i + Val(p_sum_isp)
            '            itog_1999_gv = itog_1999_gv + Val(p_gsum_vozv): itog_1999_v = itog_1999_v + Val(p_sum_vozv)
            '        Case 2
            '            itog_2999_gp = itog_2999_gp + Val(p_gsum_pol): itog_2999_p = itog_2999_p + Val(p_sum_pol)
            '            itog_2999_gi = itog_2999_gi + Val(p_gsum_isp): itog_2999_i = itog_2999_i + Val(p_sum_isp)
            '            itog_2999_gv = itog_2999_gv + Val(p_gsum_vozv): itog_2999_v = itog_2999_v + Val(p_sum_vozv)
            '    End Select
            'End If
            'Создание дополнительных итоговых строчек 1010 и 1020 и замена сумм для 1999 и 2999
            Select Case p_kod_str
                Case "1999"
                    '1010
                    P_Str = P_Str + " INSERT " + p_tabName + "(" + p_sheetsService.Range("A9") + ") VALUES (1,0,'''','''','''',''x''," + str(itog_1010_p) + "," + str(itog_1010_i) + "," + _
                        str(itog_1010_v) + "," + str(itog_1010_gp) + "," + str(itog_1010_gi) + "," + str(itog_1010_gv) + ",''1010'','''') "
                    'If itog_1999_gp > 0 Or itog_1999_p > 0 Or itog_1999_gi > 0 Or itog_1999_i > 0 Or itog_1999_gv > 0 Or itog_1999_v > 0 Then
                    '    p_gsum_pol = Str(itog_1999_gp): p_sum_pol = Str(itog_1999_p): p_gsum_isp = Str(itog_1999_gi)
                    '    p_sum_isp = Str(itog_1999_i): p_gsum_vozv = Str(itog_1999_gv): p_sum_vozv = Str(itog_1999_v)
                    'End If
                Case "2999"
                    '2010
                    P_Str = P_Str + " INSERT " + p_tabName + "(" + p_sheetsService.Range("A9") + ") VALUES (2,0,'''','''','''',''x''," + str(itog_2010_p) + "," + str(itog_2010_i) + "," + _
                        str(itog_2010_v) + "," + str(itog_2010_gp) + "," + str(itog_2010_gi) + "," + str(itog_2010_gv) + ",''2010'','''') "
                    'If itog_2999_gp > 0 Or itog_2999_p > 0 Or itog_2999_gi > 0 Or itog_2999_i > 0 Or itog_2999_gv > 0 Or itog_2999_v > 0 Then
                    '    p_gsum_pol = Str(itog_2999_gp): p_sum_pol = Str(itog_2999_p): p_gsum_isp = Str(itog_2999_gi)
                    '    p_sum_isp = Str(itog_2999_i): p_gsum_vozv = Str(itog_2999_gv): p_sum_vozv = Str(itog_2999_v)
                    'End If
            End Select
            'Обновление итоговых строчек в Excel
            'If p_kod_str = "1999" Or p_kod_str = "2999" Then
            '    p_wSheet.Cells(i, p_colFirst + 4).Value = Val(p_gsum_pol)
            '   p_wSheet.Cells(i, p_colFirst + 5).Value = Val(p_sum_pol)
            '    p_wSheet.Cells(i, p_colFirst + 6).Value = Val(p_gsum_isp)
            '    p_wSheet.Cells(i, p_colFirst + 7).Value = Val(p_sum_isp)
            '    p_wSheet.Cells(i, p_colFirst + 8).Value = Val(p_gsum_vozv)
            '    p_wSheet.Cells(i, p_colFirst + 9).Value = Val(p_sum_vozv)
            'End If
            'формирование команды для данной строчки
            P_Str = P_Str + " INSERT " + p_tabName + "(" + p_sheetsService.Range("A9") + ") VALUES (" + VBA.str(p_razdel) + "," + p_num_kind + _
                    ",''" + p_num_str + "'',''" + p_name_str + "'',''" + p_kod_ekl + "'',''" + p_num_reest + "''," + p_sum_pol + "," + p_sum_isp + "," + _
                    p_sum_vozv + "," + p_gsum_pol + "," + p_gsum_isp + "," + p_gsum_vozv + ",''" + p_kod_str + "'',''" + p_num_pp + "'') "
            
            ' Выполняем пакет команд
            If VBA.Len(P_Str) > 5000 Then
                'Call PrintFile(p_lcLogFile, 1, "EXECUTE A_EXEC ' " + P_Str + " '")
                pnwrkConnect.Execute "EXECUTE A_EXEC ' " + P_Str + " '", 2048
                P_Str = ""
            End If
        Else
            p_razdel = p_razdel + 1
        End If
    Next
    If P_Str <> "" Then
         'Call PrintFile(p_lcLogFile, 1, "EXECUTE A_EXEC ' " + P_Str + " '")
         pnwrkConnect.Execute "EXECUTE A_EXEC ' " + P_Str + " '", 2048
    End If
        
p_exitFunc:
    
End Sub
Sub CALC_REPORT_F663()
    Call REPORT_F663
End Sub
Sub CONTROL_REPORT_F663()
    
End Sub
'Палатов 30.03.2004 Процедура расчета итоговых строк для формы 663
Sub REPORT_F663()
Dim P_Str As String, i As Integer, j As Integer, p_tempStr As String, p_razdel As Integer, p_num_kind As String, p_num_str As String, p_name_str As String, p_kod_ekl As String, p_num_reest As String, _
    wSheet As Worksheet, sheetsService As Worksheet, p_kod_itog As String, p_num_pp As String, rowFirst As Integer, rowLast As Integer, colFirst As Integer, colLast As Integer, lCell As Range, rowLastItog As Integer, _
    sum_gp As Currency, sum_p As Currency, sum_gi As Currency, sum_i As Currency, sum_gv As Currency, sum_v As Currency, _
    itog_this_gp As Currency, itog_this_p As Currency, itog_this_gi As Currency, itog_this_i As Currency, itog_this_gv As Currency, itog_this_v As Currency, _
    itog_1999_gp As Currency, itog_1999_p As Currency, itog_1999_gi As Currency, itog_1999_i As Currency, itog_1999_gv As Currency, itog_1999_v As Currency, _
    itog_2020_gp As Currency, itog_2020_p As Currency, itog_2020_gi As Currency, itog_2020_i As Currency, itog_2020_gv As Currency, itog_2020_v As Currency, _
    itog_2999_gp As Currency, itog_2999_p As Currency, itog_2999_gi As Currency, itog_2999_i As Currency, itog_2999_gv As Currency, itog_2999_v As Currency
    
    P_Str = ""
    sum_gp = 0: sum_p = 0: sum_gi = 0: sum_i = 0: sum_gv = 0: sum_v = 0
    itog_this_gp = 0: itog_this_p = 0: itog_this_gi = 0: itog_this_i = 0: itog_this_gv = 0: itog_this_v = 0
    itog_1999_gp = 0: itog_1999_p = 0: itog_1999_gi = 0: itog_1999_i = 0: itog_1999_gv = 0: itog_1999_v = 0
    itog_2020_gp = 0: itog_2020_p = 0: itog_2020_gi = 0: itog_2020_i = 0: itog_2020_gv = 0: itog_2020_v = 0
    itog_2999_gp = 0: itog_2999_p = 0: itog_2999_gi = 0: itog_2999_i = 0: itog_2999_gv = 0: itog_2999_v = 0
    
    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    Set lCell = StringFunc.LastCell(wSheet.Cells)
    On Error GoTo p_exitR663

    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 Not wSheet.Cells(i, 1).Locked And rowLast < i Then rowLast = i
    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

   rowLastItog = rowFirst
      
   'пробегаем первый раз по ячейкам и заполняем итоговые суммы при суммировании реестров
    For i = rowFirst To rowLast
        If Not wSheet.Cells(i, colFirst).Locked Then
            If IsEmpty(wSheet.Cells(i, colFirst).Value) Then
                'находим суммы текущей строчки
                If IsNumeric(wSheet.Cells(i, colFirst + 4).Value) Then
                    sum_gp = wSheet.Cells(i, colFirst + 4).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 4).Value) Then
                        sum_gp = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 4).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 4).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 5).Value) Then
                    sum_p = wSheet.Cells(i, colFirst + 5).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 5).Value) Then
                        sum_p = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 5).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 5).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 6).Value) Then
                    sum_gi = wSheet.Cells(i, colFirst + 6).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 6).Value) Then
                        sum_gi = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 6).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 6).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 7).Value) Then
                    sum_i = wSheet.Cells(i, colFirst + 7).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 7).Value) Then
                        sum_i = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 7).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 7).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 8).Value) Then
                    sum_gv = wSheet.Cells(i, colFirst + 8).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 8).Value) Then
                        sum_gv = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 8).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 8).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 9).Value) Then
                    sum_v = wSheet.Cells(i, colFirst + 9).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 9).Value) Then
                        sum_v = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 9).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 9).Select
                        GoTo p_exitR663
                    End If
                End If
                'если заключительная итоговая строчка, то сбрасываем промежуточные итоги в предыдущую итоговую строчку
                If Not IsEmpty(wSheet.Cells(i, colFirst + 2).Value) Then
                    p_num_reest = wSheet.Cells(i, colFirst + 2).Value
                    If p_num_reest = "Итого по разделу 1901:" Or p_num_reest = "Итого по коду 02002:" Then
                        If itog_this_gp <> 0 Or itog_this_p <> 0 Or itog_this_gi <> 0 Or itog_this_i <> 0 _
                            Or itog_this_gv <> 0 Or itog_this_v <> 0 Then
                            wSheet.Cells(rowLastItog, colFirst + 4).Value = itog_this_gp
                            wSheet.Cells(rowLastItog, colFirst + 5).Value = itog_this_p
                            wSheet.Cells(rowLastItog, colFirst + 6).Value = itog_this_gi
                            wSheet.Cells(rowLastItog, colFirst + 7).Value = itog_this_i
                            wSheet.Cells(rowLastItog, colFirst + 8).Value = itog_this_gv
                            wSheet.Cells(rowLastItog, colFirst + 9).Value = itog_this_v
                        End If
                    End If
                End If
                itog_this_gp = itog_this_gp + sum_gp: itog_this_p = itog_this_p + sum_p
                itog_this_gi = itog_this_gi + sum_gi: itog_this_i = itog_this_i + sum_i
                itog_this_gv = itog_this_gv + sum_gv: itog_this_v = itog_this_v + sum_v
            Else
                'запись текущих итоговых сумм в предыдущую итоговую строчку и обнуление текущих итоговых сумм
                If itog_this_gp <> 0 Or itog_this_p <> 0 Or itog_this_gi <> 0 Or itog_this_i <> 0 _
                 Or itog_this_gv <> 0 Or itog_this_v <> 0 Then
                    wSheet.Cells(rowLastItog, colFirst + 4).Value = itog_this_gp
                    wSheet.Cells(rowLastItog, colFirst + 5).Value = itog_this_p
                    wSheet.Cells(rowLastItog, colFirst + 6).Value = itog_this_gi
                    wSheet.Cells(rowLastItog, colFirst + 7).Value = itog_this_i
                    wSheet.Cells(rowLastItog, colFirst + 8).Value = itog_this_gv
                    wSheet.Cells(rowLastItog, colFirst + 9).Value = itog_this_v
                End If
                itog_this_gp = 0: itog_this_p = 0: itog_this_gi = 0: itog_this_i = 0: itog_this_gv = 0: itog_this_v = 0
                rowLastItog = i
            End If
        Else
            itog_this_gp = 0: itog_this_p = 0: itog_this_gi = 0: itog_this_i = 0: itog_this_gv = 0: itog_this_v = 0
        End If
    Next

    p_razdel = 1
    p_num_str = "1"
    p_kod_itog = "1010"
    sum_gp = 0: sum_p = 0: sum_gi = 0: sum_i = 0: sum_gv = 0: sum_v = 0
    rowLastItog = 0
    
    'пробегаем второй раз по ячейкам и заполняем основные итоговые суммы
    For i = rowFirst To rowLast
        If Not wSheet.Cells(i, colFirst).Locked Then
            If Not IsEmpty(wSheet.Cells(i, colFirst).Value) Then
                'расчет основных итоговых сумм
                p_num_str = wSheet.Cells(i, colFirst).Value
                p_num_str = VBA.Left(p_num_str, VBA.Len(p_num_str) - 1)
                'находим суммы текущей строчки
                If IsNumeric(wSheet.Cells(i, colFirst + 4).Value) Then
                    sum_gp = wSheet.Cells(i, colFirst + 4).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 4).Value) Then
                        sum_gp = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 4).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 4).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 5).Value) Then
                    sum_p = wSheet.Cells(i, colFirst + 5).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 5).Value) Then
                        sum_p = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 5).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 5).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 6).Value) Then
                    sum_gi = wSheet.Cells(i, colFirst + 6).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 6).Value) Then
                        sum_gi = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 6).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 6).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 7).Value) Then
                    sum_i = wSheet.Cells(i, colFirst + 7).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 7).Value) Then
                        sum_i = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 7).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 7).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 8).Value) Then
                    sum_gv = wSheet.Cells(i, colFirst + 8).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 8).Value) Then
                        sum_gv = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 8).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 8).Select
                        GoTo p_exitR663
                    End If
                End If
                
                If IsNumeric(wSheet.Cells(i, colFirst + 9).Value) Then
                    sum_v = wSheet.Cells(i, colFirst + 9).Value
                Else
                    If IsEmpty(wSheet.Cells(i, colFirst + 9).Value) Then
                        sum_v = 0
                    Else
                        Call MsgBox("Обнаружена ячейка с неверным типом данных, требуется число", vbCritical, "Внимание, расчет не произведен!")
                        wSheet.Cells(i, colFirst + 9).Interior.color = RGB(255, 0, 0)
                        wSheet.Cells(i, colFirst + 9).Select
                        GoTo p_exitR663
                    End If
                End If
                'определяем тип строчки и суммируем итоги в зависимости от типа строчки
                If p_razdel = 1 Then
                   itog_1999_gp = itog_1999_gp + sum_gp: itog_1999_p = itog_1999_p + sum_p
                   itog_1999_gi = itog_1999_gi + sum_gi: itog_1999_i = itog_1999_i + sum_i
                   itog_1999_gv = itog_1999_gv + sum_gv: itog_1999_v = itog_1999_v + sum_v
                Else
                    Select Case p_num_str
                        Case "7"
                            rowLastItog = i
                        Case "7.1", "7.2", "7.3"
                            itog_2020_gp = itog_2020_gp + sum_gp: itog_2020_p = itog_2020_p + sum_p
                            itog_2020_gi = itog_2020_gi + sum_gi: itog_2020_i = itog_2020_i + sum_i
                            itog_2020_gv = itog_2020_gv + sum_gv: itog_2020_v = itog_2020_v + sum_v
                            
                            itog_2999_gp = itog_2999_gp + sum_gp: itog_2999_p = itog_2999_p + sum_p
                            itog_2999_gi = itog_2999_gi + sum_gi: itog_2999_i = itog_2999_i + sum_i
                            itog_2999_gv = itog_2999_gv + sum_gv: itog_2999_v = itog_2999_v + sum_v
                        Case Else
                            itog_2999_gp = itog_2999_gp + sum_gp: itog_2999_p = itog_2999_p + sum_p
                            itog_2999_gi = itog_2999_gi + sum_gi: itog_2999_i = itog_2999_i + sum_i
                            itog_2999_gv = itog_2999_gv + sum_gv: itog_2999_v = itog_2999_v + sum_v
                    End Select
                 End If
            Else
                'обновление итоговых строчек 1999 и 2999
                If Not IsEmpty(wSheet.Cells(i, colFirst + 2).Value) Then
                    p_num_reest = wSheet.Cells(i, colFirst + 2).Value
                    If p_num_reest = "Итого по разделу 1901:" Then
                        wSheet.Cells(i, colFirst + 4).Value = itog_1999_gp
                        wSheet.Cells(i, colFirst + 5).Value = itog_1999_p
                        wSheet.Cells(i, colFirst + 6).Value = itog_1999_gi
                        wSheet.Cells(i, colFirst + 7).Value = itog_1999_i
                        wSheet.Cells(i, colFirst + 8).Value = itog_1999_gv
                        wSheet.Cells(i, colFirst + 9).Value = itog_1999_v
                    End If
                    If p_num_reest = "Итого по коду 02002:" Then
                        wSheet.Cells(i, colFirst + 4).Value = itog_2999_gp
                        wSheet.Cells(i, colFirst + 5).Value = itog_2999_p
                        wSheet.Cells(i, colFirst + 6).Value = itog_2999_gi
                        wSheet.Cells(i, colFirst + 7).Value = itog_2999_i
                        wSheet.Cells(i, colFirst + 8).Value = itog_2999_gv
                        wSheet.Cells(i, colFirst + 9).Value = itog_2999_v
                    End If
                End If
            End If
        Else
            p_razdel = 2
        End If
    Next
    'обновление итоговой строчки по исполнительным листам
    If rowLastItog <> 0 Then
        wSheet.Cells(rowLastItog, colFirst + 4).Value = itog_2020_gp
        wSheet.Cells(rowLastItog, colFirst + 5).Value = itog_2020_p
        wSheet.Cells(rowLastItog, colFirst + 6).Value = itog_2020_gi
        wSheet.Cells(rowLastItog, colFirst + 7).Value = itog_2020_i
        wSheet.Cells(rowLastItog, colFirst + 8).Value = itog_2020_gv
        wSheet.Cells(rowLastItog, colFirst + 9).Value = itog_2020_v
    End If
             
         
      
p_exitR663:
    Application.StatusBar = ""
    
End Sub

