Attribute VB_Name = "SERVICE_R"
Public Blank As Integer, linkRep As String
Option Explicit
' -------------------------------------------------------------------------------------------------------
' Процедура делает невидимыми листы отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub HIDELIST()
    On Error Resume Next
    Sheets("SQLData").Visible = xlVeryHidden
    Sheets("Service").Visible = xlVeryHidden
    Sheets("Form").Visible = xlVeryHidden
    Sheets("Alg").Visible = xlVeryHidden
    Sheets("Otbor_Cond").Visible = xlVeryHidden
    Sheets("SEEK_POP_SQLDATA").Visible = xlVeryHidden
    Sheets("SQLData1").Visible = xlVeryHidden
    Sheets("Контроль").Visible = xlVeryHidden
    Sheets("Расшифровка").Visible = xlVeryHidden
    Sheets("SQLDATA2").Visible = False
    On Error GoTo 0
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура делает видимыми листы отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub ShowLists()
    Sheets("SQLData").Visible = True
    Sheets("Service").Visible = True
    Sheets("Form").Visible = True
    Sheets("Alg").Visible = True
    Sheets("Otbor_Cond").Visible = True
    Sheets("SEEK_POP_SQLDATA").Visible = True
    Sheets("SQLData1").Visible = True
    Sheets("Контроль").Visible = True
    Sheets("Расшифровка").Visible = xlVeryHidden
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура копирования данных с листа выборки на лист отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub COPY_DATA(nRowCount, page)
Dim LookRange As Range
Dim lnLink As Long
Dim lnCnt, lnCntf, otl, j, level As Integer
Dim SheetsSqlData, sheetsReport, sheetsService As Object
Dim oldDiv, oldTGT, oldExp, oldCorr As String
Dim addFlag As Boolean

    On Error GoTo doError

    Set SheetsSqlData = Application.ActiveWorkbook.Sheets("SQLData")
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    Set sheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Range("B19").Text)
    SheetsSqlData.Visible = True

    With ThisWorkbook.Sheets("Service")
        pnAddress_Row = .Range("C5")
        pnAddress_Col = .Range("C6")
    End With
    oldDiv = "0000"
    oldTGT = "000"
    oldExp = "000"
    oldCorr = "xxx"
    For lnCnt = 1 To nRowCount
        ' Заполним коллекцию существующих записей (links)
        lnLink = SheetsSqlData.Cells(lnCnt + 1, 1).Value
        If Not (pnLoadSvod = 1 And pnMode = 0) Then 'откл. при загрузке нового сводного отчета
            pNotEmptyColl(page).Add lnLink, VBA.Trim(VBA.str(lnLink))
        End If
        ' включить функции поиска
        Set LookRange = sheetsReport.Range("LINK").Find(lnLink, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not LookRange Is Nothing Then
            For j = pnAddress_Col To pnAddress_Col + sheetsService.Range("A10") - 1
                If Not Sheets(Sheets("Service").Range("B19").Text).Cells(LookRange.row, j).Locked Then
                    Sheets(Sheets("Service").Range("B19").Text).Cells(LookRange.row, j).Value = SheetsSqlData.Cells(lnCnt + 1, j - pnAddress_Col + 2).Value
                End If
            Next
        Else
            If Blank <> 0 Then 'добавить строку
                addFlag = True
                If page = 2 Then
                    If (VBA.Trim(linkRep) <> "") And (VBA.Trim(linkRep) <> "0") Then
                        level = 0
                        With sheetsService
                            .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column) = SheetsSqlData.Cells(lnCnt + 1, 2).Value
                            .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column + 1) = SheetsSqlData.Cells(lnCnt + 1, 3).Value
                            .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column + 2) = SheetsSqlData.Cells(lnCnt + 1, 4).Value
                        
                            .Cells(.Range("KRIT_CODE").row, .Range("KRIT_CODE").column - 11).CALCULATE
                            .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column - 1).CALCULATE
                            If .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column - 1) <> 1 Then
                                level = 1
                                If (oldDiv = SheetsSqlData.Cells(lnCnt + 1, 2).Value) And (oldTGT = SheetsSqlData.Cells(lnCnt + 1, 3).Value) And (oldExp = SheetsSqlData.Cells(lnCnt + 1, 4).Value) Then addFlag = False
                            Else
                                .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column + 2) = "" 'SheetsSqlData.Cells(lnCnt + 1, 3).Value
                                .Cells(.Range("KRIT_CODE").row, .Range("KRIT_CODE").column - 11).CALCULATE
                                .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column - 1).CALCULATE
                                If .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column - 1) <> 1 Then
                                    level = 2
                                    .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column + 1) = ""
                                    .Cells(.Range("KRIT_CODE").row, .Range("KRIT_CODE").column - 11).CALCULATE
                                    .Cells(.Range("KRIT_CODE").row + 1, .Range("KRIT_CODE").column - 1).CALCULATE
                                    If (oldDiv = SheetsSqlData.Cells(lnCnt + 1, 2).Value) And (oldTGT = SheetsSqlData.Cells(lnCnt + 1, 3).Value) Then
                                        If VBA.Trim(oldCorr) = VBA.Trim(SheetsSqlData.Cells(lnCnt + 1, 6).Text) Then addFlag = False
                                        SheetsSqlData.Cells(lnCnt + 1, 4).Value = ""
                                    End If
                                Else
                                If (oldDiv = SheetsSqlData.Cells(lnCnt + 1, 2).Value) Then
                                    If VBA.Trim(oldCorr) = VBA.Trim(SheetsSqlData.Cells(lnCnt + 1, 6).Text) Then addFlag = False
                                End If
                                SheetsSqlData.Cells(lnCnt + 1, 3) = ""
                                SheetsSqlData.Cells(lnCnt + 1, 4) = ""
                                End If
                            End If
                            If addFlag Then
                                oldDiv = SheetsSqlData.Cells(lnCnt + 1, 2).Value
                                oldTGT = SheetsSqlData.Cells(lnCnt + 1, 3).Value
                                oldExp = SheetsSqlData.Cells(lnCnt + 1, 4).Value
                                oldCorr = SheetsSqlData.Cells(lnCnt + 1, 6).Value
                            End If
                        End With
                    End If
                End If
                If addFlag = True Then
                    'снять защиту
                    sheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    'вставляем строку
                    sheetsReport.Cells(sheetsService.Range("A9").Value - 2, 1).EntireRow.Insert
                    otl = sheetsService.Range("A9").Value - 2
                    sheetsReport.Cells(sheetsService.Range("A9").Value - 2, 1).RowHeight = sheetsReport.Cells(sheetsService.Range("A9").Value, 1).RowHeight
                    sheetsService.Range("A9").Value = sheetsService.Range("A9").Value + 1
                    ' пропишем атрибуты строки
                    sheetsReport.Cells(otl, pnAddress_Col - sheetsService.Range("E2")).Value = lnLink
                    
                    'снять защиту
                    sheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    sheetsReport.Cells(otl, 2) = sheetsService.Range("B20").Value
                
                    'добавить данные
    
                    For j = 3 To sheetsService.Range("A10") + 2
                        Sheets(Sheets("Service").Range("B19").Text).Cells(otl, j).Value = SheetsSqlData.Cells(lnCnt + 1, j - 1).Value
                    Next
                    'снять защиту
                    sheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    Sheets(Sheets("Service").Range("B19").Text).Rows(otl).AutoFit
                    'поставить защиту
                    sheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                    Call INSERT_LINK_IN_COLLECTION("UPD", lnLink, sheetsService.Range("B20").Value)
                Else
                    'суммировать
                    'снять защиту
                    sheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    Sheets(Sheets("Service").Range("B19").Text).Cells(otl, 6).Value = Sheets(Sheets("Service").Range("B19").Text).Cells(otl, 6) + VBA.Val(SheetsSqlData.Cells(lnCnt + 1, 6 - 1).Value)
                    'поставить защиту
                    sheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                    Call INSERT_LINK_IN_COLLECTION("DEL", lnLink, sheetsService.Range("B20").Value)
                End If
            End If
        End If
    Next
    SheetsSqlData.Visible = False

Exit Sub
doError:
    Call ERROR_EVENT("COPY_DATA")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура защиты отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub REPORT_PROTECT()
Dim sheetsService, sheetsReport, SheetsControl As Object

    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    Set sheetsReport = Application.ActiveWorkbook.Sheets(Sheets("Service").Range("B19").Text)
    Set SheetsControl = Application.ActiveWorkbook.Sheets("Контроль")

    On Error GoTo doError

    With ThisWorkbook.Sheets("Service")
        pnAddress_Row = .Range("C5")
        pnAddress_Col = .Range("C6")
    End With
    'Временное снятие защиты
    sheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
    ' Заголовок сводного отчета
    sheetsReport.Activate
    sheetsReport.Range("MAIN_DATA").FormulaHidden = False
    sheetsReport.Cells(pnAddress_Row, pnAddress_Col).Select
    ' защита листа
    sheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

Exit Sub
doError:
    Call ERROR_EVENT("REPORT_PROTECT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура сохранения отчета на SQL Server
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub SAVE_REPORT()
Dim SqlStr As String
Dim lnDevide, nCnt, nCountColl, nCol, nCount, row, col, i, j As Integer
Dim oRecordSet, sheetsService, sheetsReport As Object
Dim lnLinkObject, lnObject, lnLink, CurrRow, lnColumn1, lnRow1, row11, col11, hWnd As Long
Dim DeletedLink, cSql, SqlStrDel, oldName As String
Dim LookRange As Range
Dim lbExistsValue, rafFlag As Boolean
Dim str_status() As Integer

    On Error GoTo doError
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
    ' Сохранение документа в зависимости от режима ввода
    ' 1 - удаление удаленных строк
    ' 2 - вставка новых записей
    ' 3 - обновление существующих
    Application.StatusBar = "Подождите ... Идет сохранение отчета"

    hWnd = FindWindow("XLMAIN", 0)
    LockWindowUpdate (hWnd)
    Application.ScreenUpdating = False

    ' Определим единицу измерения и переведем в копейки
    lnDevide = sheetsService.Range("A29").Value

    If sheetsService.Range("A12").Value = 1 Then
        rafFlag = True
    Else
        rafFlag = False
    End If

    ' Определим есть ли соединение с сервером
    On Error GoTo nnn
    If oAdoConnect Is Nothing Then
nnn:
        Call AdoSrvConnect
    End If
    On Error GoTo doError
    If pnLoadSvod = 1 Then
        If pnMode = 0 And sheetsService.Range("A21") <> 0 Then
            ' Удаляем предыдущий отчет
            lnLinkObject = sheetsService.Range("A21").Value
            SqlStr = "DELETE FROM REPORT_VALUES_STR WHERE LINK_UP IN (" + _
                     "SELECT LINK FROM REPORT_VALUES WHERE LINK_UP=" + VBA.Trim(VBA.str(lnLinkObject)) + " )"
            oAdoConnect.Execute ("EXECUTE A_EXEC '" + SqlStr + "'")
            SqlStr = "DELETE FROM REPORT_VALUES WHERE LINK_UP = " + VBA.Trim(VBA.str(lnLinkObject))
            SqlStr = SqlStr & " DELETE FROM REPORT_APP WHERE LINK_UP = " + VBA.Trim(VBA.str(lnLinkObject))
            SqlStr = SqlStr & " DELETE FROM REPORTS WHERE LINK = " + VBA.Trim(VBA.str(lnLinkObject))
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + "'")
        End If
    End If
    ' Определим объект для которого все будет делаться
    If pnUser = 1 And pnLoadSvod <> 1 Then ' Расчет отчета
        ' режим расчета при записи необходимо удалить предидущий рассчитанный отчет
        If pnMode = 0 And sheetsService.Range("A21").Value <> 0 Then
            ' удаляем отчет полностью из Report_Values
            lnLinkObject = sheetsService.Range("A21").Value
            SqlStr = "DELETE FROM REPORT_VALUES_STR WHERE LINK_UP IN (" + _
                     "SELECT LINK FROM REPORT_VALUES WHERE LINK_UP=" + VBA.Trim(VBA.str(lnLinkObject)) + " )"
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
            SqlStr = "DELETE FROM REPORT_VALUES WHERE LINK_UP = " + VBA.Trim(VBA.str(lnLinkObject))
            SqlStr = SqlStr & " DELETE FROM REPORT_APP WHERE LINK_UP = " + VBA.Trim(VBA.str(lnLinkObject))
            SqlStr = SqlStr & " DELETE FROM REPORTS WHERE LINK = " + VBA.Trim(VBA.str(lnLinkObject))
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
        End If
    End If

    If pnMode = 0 Then ' новый документ
        ' вставим запись в table Reports
        lnLinkObject = sheetsService.Range("A14").Value
        SqlStr = "DECLARE @link int SELECT @link = LINK FROM REPORTS WHERE OBJECT = " + VBA.Trim(VBA.str(lnLinkObject)) + " AND CORR_IN = " + VBA.Trim(VBA.str(pCorr_in)) + " AND DATE_BEGIN = ''" + VBA.Trim(pDateBegin) + "'' AND DATE_END = ''" + VBA.Trim(pDateEnd) + "'' "
        SqlStr = SqlStr + " IF @link is null INSERT REPORTS (OBJECT,CORR_IN,CORR_OUT,DATE_BEGIN,DATE_END,USERS, DATE_IN) VALUES (" + _
                VBA.Trim(VBA.str(lnLinkObject)) + "," + _
                VBA.Trim(VBA.str(pCorr_in)) + "," + _
                IIf(pnUser = 1, IIf(VBA.Trim(VBA.str(pCorr_out)) = 0, "NULL", VBA.Trim(VBA.str(pCorr_out))), "NULL") + "," + _
                "''" + VBA.Trim(pDateBegin) + "''," + _
                "''" + VBA.Trim(pDateEnd) + "'', NULL, getDate())" + " else select [LINK]=@link"
                
        ' выполнени insert на SQL server
        Set oRecordSet = CreateObject("ADODB.RecordSet")
        oRecordSet.Open "EXECUTE A_EXEC ' " + SqlStr + " '", oAdoConnect, 2, 1, 1
        ' получим LINK вновь вставленного объекта
        lnObject = VBA.Trim(VBA.str(oRecordSet.Fields("LINK")))
        oRecordSet.Close
        Set oRecordSet = Nothing
        ' сохраним LINK
        sheetsService.Range("A21").Value = lnObject
        ' переход в режим редактирования
        sheetsService.Range("A1").Value = 1
        pnMode = 1
    Else
        lnObject = sheetsService.Range("A21").Value
    End If


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

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

    oldName = sheetsService.Range("B19").Text
    For i = 1 To sheetsService.Range("B23")
        SqlStr = ""
        'установим страницу зададим критерий
        sheetsService.Cells(lnRow1 + 1, lnColumn1) = i
        If sheetsService.Range("B23") = 1 Then
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Range("B19").Text)
        Else
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
        End If
        Blank = sheetsService.Cells(lnRow1 + 4, lnColumn1)
        sheetsReport.Activate
        ReDim str_status(sheetsService.Range("A10"))
    
        For j = 1 To sheetsService.Range("A10").Value
            'критерий для колонок с данными
            sheetsService.Cells(row11 + 1, col11) = j
            sheetsService.Cells(row11 + 1, col11 + 1) = ""
            str_status(j) = sheetsService.Cells(row11 + 4, col11).Value
        Next
        With ThisWorkbook.Sheets("Service")
            pnAddress_Row = .Range("C5")
            pnAddress_Col = .Range("C6")
        End With

        ' Этап 1 удаление
        ' определим номера удаляемых bars
        nCountColl = pDELColl(i).count
        If nCountColl > 0 Then 'есть удаленные записи
            'Stop
            DeletedLink = ""
            For nCnt = 1 To nCountColl
                lnLink = pDELColl(i)(nCnt)
                DeletedLink = DeletedLink + IIf(DeletedLink <> "", ",", "") + VBA.str(pDELColl(i)(nCnt))
            Next
            'Сформируем строку deleted
            SqlStr = "DELETE FROM REPORT_VALUES_STR WHERE LINK_UP IN (" + _
                   "SELECT LINK FROM REPORT_VALUES WHERE " + IIf(rafFlag, "LINK_RAF", "LINK_UP") + "=" + VBA.Trim(VBA.str(lnObject)) + _
                   " AND BARS IN(" + DeletedLink + _
                   ") and OBJECT=" + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + " )"
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
            SqlStr = "DELETE FROM REPORT_VALUES WHERE " + IIf(rafFlag, "LINK_RAF", "LINK_UP") + " = " + VBA.Trim(VBA.str(lnObject)) + " AND BARS IN(" + DeletedLink + ") and OBJECT=" + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i))
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
            ' Удаление из коллекции
            For nCnt = 1 To pDELColl(i).count
                pDELColl(i).Remove (1)
            Next
        End If

        ' Этап 2 вставка новых записей
        SqlStr = ""
        nCountColl = pINSColl(i).count
        If nCountColl > 0 Then 'есть записи для вставки
            For nCnt = 1 To nCountColl
                cSql = ""
                lnLink = pINSColl(i)(nCnt)
                Set LookRange = sheetsReport.Range("LINK").Find(lnLink, LookIn:=xlFormulas, lookat:=xlWhole)
                If Not LookRange Is Nothing Then
                    CurrRow = LookRange.row
                    lbExistsValue = False
                    For nCol = 0 To sheetsService.Range("A10") - 1
                        If str_status(nCol + 1) = 0 Then
                            cSql = cSql + " INSERT REPORT_VALUES (" + IIf(rafFlag, "LINK_RAF", "LINK_UP") + ",OBJECT,BARS,GRAFS,VALUE) VALUES(" + _
                            VBA.Trim(VBA.str(lnObject)) + "," + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + "," + _
                            VBA.Trim(VBA.str(lnLink)) + "," + _
                            VBA.Trim(VBA.str(nCol + 1)) + "," + _
                            VBA.Trim(VBA.str(sheetsReport.Cells(CurrRow, IIf(Blank = 0, pnAddress_Col, 3) + nCol).Value * lnDevide)) + ")"
                            'Проверка на наличия значений
                            If sheetsReport.Cells(CurrRow, IIf(Blank = 0, pnAddress_Col, 3) + nCol).Value <> 0 Then
                                lbExistsValue = True
                            End If
			Else
                                cSql = cSql + " EXECUTE V_ADD_REPORT_VALUES " + _
                                            VBA.Trim(VBA.str(lnObject)) + "," + _
                                            IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + "," + _
                                            VBA.Trim(VBA.str(lnLink)) + "," + _
                                            VBA.str(nCol + 1) + "," + _
                                            "NULL" + "," + _
                                            "''" + sheetsReport.Cells(CurrRow, IIf(Blank = 0, pnAddress_Col, 3) + nCol).Text + "''"
                            ' Проверка на наличия значений
                            If sheetsReport.Cells(CurrRow, pnAddress_Col + nCol).Text <> "" Then
                                lbExistsValue = True
                            End If
                        End If
                        Next
                    If lbExistsValue Then
                        SqlStr = SqlStr + cSql
                        lbExistsValue = False
                        ' Заносим в коллекцию уже существующих
                        pNotEmptyColl(i).Add lnLink, VBA.Trim(VBA.str(lnLink))
                    End If
                    'Сформируем строку insert на SQL Server
                    ' Проверим пакет
                    If VBA.Len(SqlStr) > 5000 Then
                        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
                        SqlStr = ""
                    End If
                End If
            Next
            ' Удаление из коллекции
            For nCnt = 1 To pINSColl(i).count
                pINSColl(i).Remove (1)
            Next
            'Выполним оставшиеся insert на SQL Server
            If SqlStr <> "" Then
                oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
            End If
        End If

        ' Этап 3 обновление существующих записей
        SqlStr = ""
        SqlStrDel = ""
        nCountColl = pUPDColl(i).count
        If nCountColl > 0 Then 'есть записи для update
            For nCnt = 1 To nCountColl
                lnLink = pUPDColl(i)(nCnt)
                Set LookRange = sheetsReport.Range("LINK").Find(lnLink, LookIn:=xlFormulas, lookat:=xlWhole)
                If Not LookRange Is Nothing Then
                    CurrRow = LookRange.row
                    lbExistsValue = False
                    'cSql = ""
                    'Сначала удалим старые данные
                    cSql = " DELETE FROM REPORT_VALUES_STR WHERE LINK_UP IN (" + _
                           "SELECT LINK FROM REPORT_VALUES WHERE " + IIf(rafFlag, "LINK_RAF", "LINK_UP") + "=" + VBA.Trim(VBA.str(lnObject)) + _
                           " AND BARS IN(" + VBA.Trim(VBA.str(lnLink)) + _
                           ") and OBJECT=" + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + " )"
                    cSql = cSql + " DELETE FROM REPORT_VALUES WHERE " + IIf(rafFlag, "LINK_RAF", "LINK_UP") + " = " + VBA.Trim(VBA.str(lnObject)) + " AND BARS IN(" + VBA.Trim(VBA.str(lnLink)) + ") and OBJECT=" + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i))
                    For nCol = 0 To sheetsService.Range("A10") - 1
                        If str_status(nCol + 1) = 0 Then
                            cSql = cSql + " INSERT REPORT_VALUES (" + IIf(rafFlag, "LINK_RAF", "LINK_UP") + ",OBJECT,BARS,GRAFS,VALUE) VALUES(" + _
                            VBA.Trim(VBA.str(lnObject)) + "," + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + "," + _
                            VBA.Trim(VBA.str(lnLink)) + "," + _
                            VBA.Trim(VBA.str(nCol + 1)) + "," + _
                            VBA.Trim(VBA.str(sheetsReport.Cells(CurrRow, IIf(Blank = 0, pnAddress_Col, 3) + nCol).Value * lnDevide)) + ")"
                            ' Проверка на наличия значений
                            If sheetsReport.Cells(CurrRow, IIf(Blank = 0, pnAddress_Col, 3) + nCol).Value <> 0 Then
                                lbExistsValue = True
                            End If
                        Else
                            cSql = cSql + " EXECUTE V_ADD_REPORT_VALUES " + _
                                    VBA.Trim(VBA.str(lnObject)) + "," + _
                                    IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + "," + _
                                    VBA.Trim(VBA.str(lnLink)) + "," + _
                                    VBA.str(nCol + 1) + "," + _
                                    "NULL" + "," + _
                                    "''" + sheetsReport.Cells(CurrRow, IIf(Blank = 0, pnAddress_Col, 3) + nCol).Text + "''"
                       
                            ' Проверка на наличия значений
                            If sheetsReport.Cells(CurrRow, pnAddress_Col + nCol).Text <> "" Then
                                lbExistsValue = True
                            End If
                        End If
                    Next
                    If lbExistsValue Then
                        SqlStr = SqlStr + cSql
                    Else
                        SqlStrDel = SqlStrDel + " DELETE REPORT_VALUES_STR WHERE LINK_UP IN(SELECT LINK FROM REPORT_VALUES WHERE " + IIf(rafFlag, "LINK_RAF", "LINK_UP") + "=" + VBA.Trim(VBA.str(lnObject)) + " AND BARS = " + VBA.Trim(VBA.str(lnLink)) + " AND OBJECT=" + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i)) + ") "
                        SqlStrDel = SqlStrDel + " DELETE FROM REPORT_VALUES WHERE " + IIf(rafFlag, "LINK_RAF", "LINK_UP") + "=" + VBA.Trim(VBA.str(lnObject)) + " AND BARS = " + VBA.Trim(VBA.str(lnLink)) + " AND OBJECT=" + IIf(sheetsService.Range("B23") = 1, "0", VBA.str(i))
                        ' Удаляем из коллекции уже существующих
                        pNotEmptyColl(i).Remove VBA.Trim(VBA.str(lnLink))
                    End If
                    'Сформируем строку update на SQL Server
                    ' Проверим пакет
                    If VBA.Len(SqlStr) > 5000 Then
                        ' Выполняем пакет команд
                        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
                        SqlStr = ""
                    End If
                    If VBA.Len(SqlStrDel) > 5000 Then
                        ' Выполняем пакет команд
                        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStrDel + " '")
                        SqlStrDel = ""
                    End If
                End If
            Next
        
            For nCnt = 1 To pUPDColl(i).count
                pUPDColl(i).Remove (1)
            Next
            'Остатки от пакета update on Server
            If SqlStr <> "" Then
                oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + " '")
            End If
            'Остатки от пакета с удаление
            If SqlStrDel <> "" Then
            oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStrDel + " '")
            End If
        End If
    
        'проверим After_Save
        If VBA.Trim(sheetsService.Range("B26")) <> "" Then
            Call Application.Run(sheetsService.Range("B26").Text, i)
        End If
www:
    Next
    Sheets(oldName).Activate
    sheetsService.Cells(lnRow1 + 1, lnColumn1) = ""
    If Sheets("Service").Range("B72") <> "" Then  'справка к балансу
        SqlStr = ""
        lnLinkObject = sheetsService.Range("A21").Value
        SqlStr = "DELETE FROM REPORT_VALUES_STR WHERE LINK_UP IN (" + _
                 "SELECT LINK FROM REPORT_VALUES WHERE OBJECT = 1 AND LINK_UP=" + VBA.Trim(VBA.str(lnLinkObject)) + " )"
        oAdoConnect.Execute ("EXECUTE A_EXEC '" + SqlStr + "'")
        SqlStr = "DELETE FROM REPORT_VALUES WHERE OBJECT = 1 AND LINK_UP = " + VBA.Trim(VBA.str(lnLinkObject))
        oAdoConnect.Execute ("EXECUTE A_EXEC ' " + SqlStr + "'")

        For row = Sheets("Справка").Range("MAIN_DATA_2").row To Sheets("Справка").Range("MAIN_DATA_2").row + Sheets("Справка").Range("MAIN_DATA_2").Rows.count - 1
            For col = 1 To Sheets("Справка").Range("Main_Data_2").Columns.count
                If col = 1 Then
                    If VBA.Trim(Sheets("Справка").Cells(row, col)) = "" Then GoTo qNext
                    SqlStr = SqlStr + " INSERT REPORT_VALUES (LINK_UP,OBJECT,BARS,GRAFS,VALUE) VALUES(" + VBA.Trim(VBA.str(lnObject)) + ",1," + VBA.Trim(VBA.str(row - Sheets("Справка").Range("MAIN_DATA_2").row + 1)) + "," + VBA.Trim(VBA.str(col)) + ",null)"
                    SqlStr = SqlStr + " INSERT REPORT_VALUES_STR (LINK_UP, VALUE) VALUES(SCOPE_IDENTITY(), '" + VBA.Trim(Sheets("Справка").Cells(row, col)) + "')"
                Else
                    SqlStr = SqlStr + " INSERT REPORT_VALUES (LINK_UP,OBJECT,BARS,GRAFS,VALUE) VALUES(" + VBA.Trim(VBA.str(lnObject)) + ",1," + VBA.Trim(VBA.str(row - Sheets("Справка").Range("MAIN_DATA_2").row + 1)) + "," + VBA.Trim(VBA.str(col)) + "," + VBA.Trim(VBA.str(Sheets("Справка").Cells(row, col))) + ")"
                End If
            Next
            If VBA.Len(SqlStr) > 300000 Then
                ' Выполняем пакет команд
                oAdoConnect.Execute (SqlStr)
                SqlStr = ""
            End If
qNext:
        Next
        If VBA.Len(SqlStr) > 0 Then
            ' Выполняем пакет команд
            oAdoConnect.Execute (SqlStr)
            SqlStr = ""
        End If

    End If

    Application.StatusBar = False
    LockWindowUpdate (0)
    Application.ScreenUpdating = True

Exit Sub
doError:
    Call ERROR_EVENT("SAVE_REPORT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Скрыть пустые строки отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub HIDE_SHOW_BLANK_LINES()
Dim i, lnRow1, lnColumn1, j, k, Blank As Integer
Dim sheetsService, sheetsReport, bar, oldRep As Object
Dim flag, blankFlag As Boolean

    On Error GoTo doError
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")

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

    For Each bar In ToolbarAction.Controls
        If bar.Caption = "Скрыть пустые строки отчета" Then
            bar.Caption = "Показать пустые строки отчета"
            bar.FaceId = 1653
            flag = True
        Else
            If bar.Caption = "Показать пустые строки отчета" Then
                bar.Caption = "Скрыть пустые строки отчета"
                bar.FaceId = 1654
                flag = False
            End If
        End If
    Next

    Set oldRep = Sheets(sheetsService.Range("B19").Text)
    Application.ScreenUpdating = False
    For i = 1 To sheetsService.Range("B23")
        ' установим страницу
        ' зададим критерий
        sheetsService.Cells(lnRow1 + 1, lnColumn1) = i
        If sheetsService.Range("B23") = 1 Then
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Range("B19").Text)
        Else
            Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
        End If
        Blank = sheetsService.Cells(lnRow1 + 4, lnColumn1)
        sheetsReport.Activate
    
        'снять защиту
        sheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
        If Blank <> 1 Then 'прячем
            'if ToolbarAction.
            For j = sheetsService.Range("C5") To sheetsService.Range("A9")
                ' Проверим
                If Not (sheetsService.Range("B67").Text <> "" And sheetsReport.Cells(j, 1) = 0) Then
                    blankFlag = True
                    For k = sheetsService.Range("C6") To sheetsService.Range("C6") + sheetsService.Range("A10") - 1
                        If VBA.Val(sheetsReport.Cells(j, k).Text) <> 0 Then blankFlag = False
                    Next
                
                    If blankFlag And flag Then 'скрыть
                        sheetsReport.Rows(j).RowHeight = 0
                    End If
                    If Not flag Then 'показать
                        sheetsReport.Rows(j).AutoFit
                    End If
                End If
            Next
        End If
        'поставить защиту
        sheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    Next
    oldRep.Activate
    Application.ScreenUpdating = True
    Exit Sub
doError:
    Call ERROR_EVENT("HIDE_SHOW_BLANK_LINES")
End Sub
' -------------------------------------------------------------------------------------------------------
