Attribute VB_Name = "INIT_R"
Option Explicit

#If Win64 Then
        Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
        Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
#Else
        Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
        Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

#End If
Public ToolbarAction As Object
' -------------------------------------------------------------------------------------------------------
' Инициализация переменных
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub INITVARS()
Dim SheetsService As Object, SheetsData As Object, SheetsReport As Object, count
    
    On Error GoTo doError
    Set SheetsService = Worksheets("Service")
    With SheetsService
        pnAddress_Row = .Range("C5")                ' начало заполнения листа отчета - с какой записи
        pnAddress_Col = .Range("C6")                ' с какой колонки
        Sheets("Service").Range("A37").Value = 1    ' включение события Update
        pCodeObject = .Range("A15").Value           ' Код объкта в S__OBJECTS
        pCorr_in = .Range("A16").Value
        pCorr_out = .Range("A17").Value
        pDateBegin = .Range("A18").Value
        pDateEnd = .Range("A19").Value
        pUser_id = .Range("A20").Value              ' Id пользователя
        pnMode = .Range("A1").Value                 ' 0 - новый , 1 - на редактирование
        pnUser = .Range("A11").Value                ' 1 - наш отчет , 0 - нижестоящего
        pnCurrentRow = 0
        pbShablon = False
        pnLoadSvod = .Range("A35")
        pnCalc = .Range("A38")
        pcNameApp = .Range("C1")
        count = Sheets("Service").Range("B23")
        ReDim pUPDColl(count)
        ReDim pINSColl(count)
        ReDim pDELColl(count)
        ReDim pNotEmptyColl(count)
        ReDim controlData(count)
        ReDim algData(count)
        ReDim letArr(count)
        Call init_data
End With

Exit Sub
doError:
    Call ERROR_EVENT("INITVARS")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура формирования отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub DOREPORT()

    On Error GoTo doError
    Dim hWnd As Long
    Application.StatusBar = "Подождите ... Идет загрузка данных"
    hWnd = FindWindow("XLMAIN", 0)
    LockWindowUpdate (hWnd)
    Application.ScreenUpdating = False
    Call INITVARS    ' инициализация переменных
    On Error GoTo nnn
    If oAdoConnect Is Nothing Then
nnn:    'ADO Соединение
        Call AdoSrvConnect
    End If

    On Error GoTo doError
    Application.Calculation = xlCalculationManual
    Call TOOLBAR_INIT   'Панель инструментов
    Call MENU_INIT      'Меню пользовтеля
    
    If pnLoadSvod >= 1 Then ' Загрузка сводного расчета
        If pnLoadSvod = 2 Then ' Загрузка данных пользователя
            Sheets("Service").Range("A37").Value = 1
            Call GetSQLData ' Вызов процедуры Заполнения сохраненных ранее данных
        Else
            Sheets("Service").Range("A38").Value = 1
            If pnMode = 0 Then ' new
                Sheets("Service").Range("A37").Value = 0
                Call GetSQLData_SVOD
            Else
                Sheets("Service").Range("A37").Value = 1
                Call GetSQLData ' exists
            End If
        End If
    Else
        If pnUser = 1 And pnMode = 0 And pnCalc = 1 Then  ' произвести расчет
            Application.Calculation = xlCalculationAutomatic
            Sheets("Service").Range("A37").Value = 0
            Sheets("Service").Range("A38").Value = 0
            Call GetSQLData_CALC ' Вызов процедуры расчета и заполнение данных соответствующего листа

            LockWindowUpdate (0)
            Application.StatusBar = "Подождите ... Идет расчет отчета"
            LockWindowUpdate (hWnd)
            Call CALC_ALL_REPORT 'Вызов процедуры расчета

            Application.StatusBar = "Подождите ... Идет форматирование данных"
            LockWindowUpdate (hWnd)
            Application.ScreenUpdating = False
        Else
            ' Проверим есть ли такой отчет
            If pnMode = 1 Then
                Sheets("Service").Range("A37").Value = 1
                Call GetSQLData 'Заполнение сохраненных ранее данных
            End If
            Sheets("Service").Range("A38").Value = 1
        End If
    End If
    Call FORMAT_CELL
    Call HIDELIST
    Call REPORT_PROTECT
    Sheets("Service").Range("A37").Value = 0
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = ""
    LockWindowUpdate (0)
    Application.ScreenUpdating = True

Exit Sub
doError:
    Call ERROR_EVENT("DOREPORT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Панель инструментов
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub TOOLBAR_INIT()
    On Error GoTo doError
    Set ToolbarAction = CommandBars.Add(Name:="Редактор", Position:=msoBarTop, Temporary:=True)
    If pnUser = 1 And pnLoadSvod = 0 Then
        'Произвести расчет отдельного элемента таблицы
        With ToolbarAction.Controls.Add(Type:=msoControlButton)
            .FaceId = 313
            .Style = msoButtonIcon
            .Caption = "Режим расчета"
            .OnAction = "CALC_PART_REPORT"
        End With
    End If
    
    'Контроль
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
        .FaceId = 215
        .Style = msoButtonIcon
        .Caption = "Контроль"
        .OnAction = "CONTROL_REPORT"
    End With
    
    'Печать
    Application.CommandBars("Редактор").Controls.Add Type:=msoControlButton, id:=109
    With Application.CommandBars("Редактор").Controls.Add(Type:=msoControlButton, id:=2521)
        .Caption = "Печать текущего документа"
    End With
    
    'Сохранение документа в EXCEL
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
        .FaceId = 2105
        .Style = msoButtonIcon
        .Caption = "Сохранить как EXCEL-файл"
        .OnAction = "SAVE_REPORT_XLS"
    End With
        
    ' Сохранение документа на SQLServer
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
        .FaceId = 3
        .Style = msoButtonIcon
        .Caption = "Сохранить данные отчета"
        .OnAction = "SAVE_REPORT"
    End With
    ToolbarAction.Visible = True
    
    'Скрыть пустые строки отчета
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
        .FaceId = 1652
        .Style = msoButtonIcon
        .Caption = "Скрыть пустые строки отчета"
        .OnAction = "HIDE_SHOW_BLANK_LINES"
    End With

Exit Sub
doError:
    Call ERROR_EVENT("TOOLBAR_INIT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Меню пользователя
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub MENU_INIT()
Dim www As Object, i As Integer
  
    On Error GoTo doError
    Application.CommandBars.Add(Name:="Строка меню отчета", Position:=msoBarTop, Temporary:=True).Visible = True
    Set www = Application.CommandBars("Строка меню отчета").Controls.Add(Type:=msoControlPopup)
    www.Caption = "&Отчет"
    www.Controls.Add Type:=msoControlButton, id:=109, Before:=1
    www.Controls.Add Type:=msoControlButton, id:=4, Before:=2
    www.Controls.Add Type:=msoControlButton, id:=247, Before:=3
    With www.Controls.Add(Type:=msoControlButton, id:=3, Before:=4)
        .OnAction = "SAVE_REPORT"
        .Caption = "Сохранить данные отчета"
        .BeginGroup = True
    End With
    www.Controls.Add Type:=msoControlButton, id:=752, Before:=5
        
    Set www = Application.CommandBars("Строка меню отчета").Controls.Add(Type:=msoControlPopup, Before:=2)
    www.Caption = "&Правка"
    www.Controls.Add Type:=msoControlSplitDropdown, id:=128, Before:=1
    www.Controls.Add Type:=msoControlSplitDropdown, id:=129, Before:=2
    www.Controls.Add Type:=msoControlButton, id:=21, Before:=3
    www.Controls.Add Type:=msoControlButton, id:=19, Before:=4
    www.Controls.Add Type:=msoControlButton, id:=22, Before:=5
    www.Controls.Add Type:=msoControlButton, id:=1849, Before:=6
    www.Controls.Add Type:=msoControlButton, id:=313, Before:=7
    www.Controls.Add Type:=msoControlButton, id:=757, Before:=8
    
    Set www = Application.CommandBars("Строка меню отчета").Controls.Add(Type:=msoControlPopup, Before:=3)
    www.Caption = IIf(pnUser = 1 And pnLoadSvod = 0, "&Расчет", "Се&рвис")
    With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=1)
        .Caption = "&Режим расчета"
        .OnAction = "CALC_PART_REPORT"
    End With

    With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=2)
        .Caption = "&Контроль"
        .OnAction = "CONTROL_REPORT"
    End With
        
    With www.Controls.Add(Type:=msoControlButton, id:=283, Before:=IIf(pnUser = 1 And pnLoadSvod = 0, 3, 1))
        .Caption = "Калькулятор"
        .OnAction = "show_Calc"
    End With
    Set www = Application.CommandBars("Строка меню отчета").Controls.Add(Type:=msoControlPopup, Before:=4)
    www.Caption = "&?"
    
    www.Controls.Add Type:=msoControlButton, id:=984, Before:=1
    With www.Controls.Add(Type:=msoControlButton, id:=124, Before:=2)
        .Caption = "Что это такое?"
    End With

    Set www = Application.CommandBars("Строка меню отчета").Controls.Add(Type:=msoControlPopup, Before:=4)
    www.Caption = "&Бланк"
    www.Visible = False
    With www.Controls.Add
        .Caption = "&Добавить строку"
        .OnAction = "Add_str"
    End With
    With www.Controls.Add
        .Caption = "&Удалить строку"
        .OnAction = "Del_str"
    End With
    
    For i = 1 To Application.CommandBars.count
        Application.CommandBars(i).Enabled = False
    Next

    ToolbarAction.Enabled = True
    ToolbarAction.Visible = True
    Application.CommandBars("Строка меню отчета").Enabled = True
    Application.CommandBars("Строка меню отчета").Visible = True
    Application.CommandBars("Worksheet Menu Bar").Enabled = False
    Application.DisplayFormulaBar = False
    Application.CommandBars("Standard").Visible = False
    
Exit Sub
doError:
    Call ERROR_EVENT("MENU_INIT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Процедура вывода в отчет дополнительных данных
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub FORMAT_CELL()
Dim SheetsControl, SheetsReport, SheetsService, SheetsSqlData As Object
Dim lnMetric, i As Integer
Dim lcEd, mainData As String

    On Error GoTo doError
    Set SheetsReport = Worksheets(Application.Names("METRIC").RefersToRange.Worksheet.Name)
    Set SheetsService = Worksheets("Service")
    Set SheetsSqlData = Worksheets("SQLData")
    Set SheetsControl = Application.ActiveWorkbook.Sheets("Контроль")
    lnMetric = SheetsService.Range("A28").Value
    With SheetsReport
        ' защита листа снимаем
        .Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
        lcEd = Application.Names("METRIC").RefersToRange.Value
        Select Case lnMetric
            Case 1
                .Range("METRIC").Value = VBA.Trim(lcEd) + " Руб. коп."
            Case 2
                .Range("METRIC").Value = VBA.Trim(lcEd) + " Тыс. руб."
            Case 3
                .Range("METRIC").Value = VBA.Trim(lcEd) + " Млн. руб."
            Case 4
                .Range("METRIC").Value = VBA.Trim(lcEd) + " Млрд. руб."
            Case 5
                .Range("METRIC").Value = VBA.Trim(lcEd) + " Тыс. руб.(с точностью до одного десятичного знака)"
        End Select

        SheetsReport.Select
        pnAddress_Row = SheetsService.Range("C5")
        pnAddress_Col = SheetsService.Range("C6")
        Rows(VBA.Trim(VBA.str(pnAddress_Row)) + ":" + VBA.Trim(VBA.str(pnAddress_Row))).Select
        If exists_name("DATE") Then 'Дата
            SheetsReport.Range("DATE") = SheetsReport.Range("DATE") + SheetsService.Range("B1")
        End If
        If exists_name("CORR") Then 'Наименование корреспондента
        SheetsReport.Range("CORR") = SheetsReport.Range("CORR") + VBA.Right(VBA.Trim(SheetsService.Range("B2")), VBA.Len(VBA.Trim(SheetsService.Range("B2"))) - VBA.InStr(VBA.Trim(SheetsService.Range("B2")), "-"))
        End If
        If exists_name("BUDGET_NAME") Then 'Наименование бюджета
        SheetsReport.Range("BUDGET_NAME") = SheetsReport.Range("BUDGET_NAME") + VBA.Trim(SheetsService.Range("A53"))
        End If
        If exists_name("PERIOD") Then 'Период
        SheetsReport.Range("PERIOD") = SheetsReport.Range("PERIOD") + VBA.Trim(SheetsService.Range("B5"))
        End If
        If exists_name("USER_OKPO1") Then ' ОКПО
            SheetsReport.Range("USER_OKPO1") = SheetsReport.Range("USER_OKPO1") + VBA.Trim(SheetsService.Range("A200"))
        End If
        If exists_name("OKATO") Then 'ОКАТО
            SheetsReport.Range("OKATO") = SheetsReport.Range("OKATO") + VBA.Trim(SheetsService.Range("A201"))
        End If
        If exists_name("DepBK") Then 'Код главы
            SheetsReport.Range("DepBK") = SheetsReport.Range("DepBK") + VBA.Trim(SheetsService.Range("A202"))
        End If

        If SheetsService.Range("A50").Value <> "" Then 'Footer1
            Set SheetsReport = Worksheets(Application.Names("WRITE_1").RefersToRange.Worksheet.Name)
            SheetsReport.Range("WRITE_1").Value = SheetsService.Range("A50").Value
            SheetsReport.Select
            SheetsReport.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

            Call AutoFitRow(SheetsReport.Range("WRITE_1"), SheetsService.Range("B48"))
            If exists_name("WRITE_1_ADD1") Then
                Sheets(Application.Names("WRITE_1_ADD1").RefersToRange.Worksheet.Name).Select
                ' защита листа снимаем
                Sheets(Application.Names("WRITE_1_ADD1").RefersToRange.Worksheet.Name).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                Sheets(Application.Names("WRITE_1_ADD1").RefersToRange.Worksheet.Name).Range("WRITE_1_ADD1").Value = SheetsService.Range("A50").Value
                Call AutoFitRow(Sheets(Application.Names("WRITE_1_ADD1").RefersToRange.Worksheet.Name).Range("WRITE_1_ADD1"), SheetsService.Range("B48"))
                SheetsReport.Select
            End If
        End If
        If SheetsService.Range("A51").Value <> "" Then 'Footer2
            SheetsReport.Range("WRITE_2") = SheetsService.Range("A51").Value
        End If
        If SheetsService.Range("A52").Value <> "" Then 'Footer3
            SheetsReport.Range("WRITE_3") = SheetsService.Range("A52").Value
        End If
        SheetsReport.Cells(pnAddress_Row, pnAddress_Col).Select
        Application.ActiveWorkbook.Windows(1).Caption = SheetsService.Range("C3")
        Application.Caption = SheetsService.Range("C1") + SheetsService.Range("C2")
        SheetsReport.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
    End With
Exit Sub
doError:
    Call ERROR_EVENT("FORMAT_CALL")

End Sub
' -------------------------------------------------------------------------------------------------------
' Сохранение отчета
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub SAVE_REPORT_XLS()
Dim dlgAnswer
    dlgAnswer = Application.Dialogs(xlDialogSaveAs).Show
End Sub
' -------------------------------------------------------------------------------------------------------