Attribute VB_Name = "init_template"
Option Explicit

Public	pcNameApp, pnAddress_Row, pnAddress_Col As Long
Public	cSrv, cDb, cUser, cPwd As String
Public	nNtUser As Long   'Flag: 0 - Sql Connect, 1 - Win Connect
Public	KRIT_ALG_COLUMNCOUNT, KRIT_ALG_COLUMN, KRIT_ALG_ROW, KRIT_FORM_COLUMNCOUNT, KRIT_FORM_COLUMN, KRIT_FORM_ROW, KRIT_SHABLON_COND_COLUMNCOUNT, KRIT_SHABLON_COND_COLUMN, KRIT_SHABLON_COND_ROW, _
        KRIT_SPR_COLUMNCOUNT, KRIT_SPR_COLUMN, KRIT_SPR_ROW, KRIT_SQLDATA1_COLUMNCOUNT, KRIT_SQLDATA1_COLUMN, KRIT_SQLDATA1_ROW, KRIT_STR_COND_COLUMNCOUNT, KRIT_STR_COND_COLUMN, KRIT_STR_COND_ROW, _
        KRIT_GRAF_COLUMNCOUNT, KRIT_GRAF_COLUMN, KRIT_GRAF_ROW, KRIT_RAZDEL_COLUMNCOUNT, KRIT_RAZDEL_COLUMN, KRIT_RAZDEL_ROW, KRIT_ZNAK_COLUMNCOUNT, KRIT_ZNAK_COLUMN, KRIT_ZNAK_ROW, _
        KRIT_TYPE_FORMULA_COLUMNCOUNT, KRIT_TYPE_FORMULA_COLUMN, KRIT_TYPE_FORMULA_ROW As Long
Public	pUPDColl() As New VBA.Collection, pINSColl() As New VBA.Collection, _
        pDELColl() As New VBA.Collection, pNotEmptyColl() As New VBA.Collection, _
        pCodeObject, pCorr_in, pCorr_out, pDateBegin, pDateEnd, pbFormCancel As Boolean, pbShablon, _
        pnGrafLINKForFormula As Long, pnCodeItogForFormula, pnCurrentRow As Integer, ToolbarAction As Object

#If Win64 Then
    Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
#Else
    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
#End If
' -------------------------------------------------------------------------------------------------------
' Модуль импорта файлов
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub Import_File()
Dim lcPath As String
Dim i, c, r

    On Error GoTo doError
    ' Удаляем reference на DAO
    For Each r In Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References
        IF Not r.IsBroken Then 'Объект Reference представляет допустимую ссылку в реестре.
            If VBA.InStr(1, VBA.UCase(r.Name), "DAO") <> 0 Then
                Application.VBE.VBProjects(Application.ThisWorkbook.VBProject.Name).References.Remove(r)
            End If
        End If
    Next
    On Error GoTo doError
    For Each i In ThisWorkbook.VBProject.VBComponents
        If (i.name = "INIT_R") Or (i.name = "sqlServer") _
           Or (i.name = "StringFunc") Or (i.name = "CONTROL_R") _
           Or (i.name = "CALCULATE_CELL_R") Or (i.name = "SEEK_POP") _
           Or (i.name = "SERVICE_R") Or (i.name = "SQLSERVER_R") _
           Or (i.name = "ADDCOND") Or (i.name = "INFILE") _
           Or (i.name = "SQLSERVER") Then
              Set c = i
              ThisWorkbook.VBProject.VBComponents.Remove (c)
        End If
    Next

    With ThisWorkbook.VBProject.VBComponents
        lcPath = ThisWorkbook.Sheets("Start").Range("A3")
        ' Load module
        .Import (lcPath + "CALCULATE.bas")
        .Import (lcPath + "SERVICE.bas")
        .Import (lcPath + "SQLSERVER.bas")
        .Import (lcPath + "STRINGFUNC.bas")
        .Import (lcPath + "TEMPLATE.bas")
        .Import (lcPath + "CONTROL_R.bas")
        'Load Form
	#If Win64 Then
            'не грузим форму
	#Else
            .Import (lcPath + "ADDSTR_FORM.frm")
            .Import (lcPath + "ALG_EDIT.frm")
            .Import (lcPath + "CHOOSE_ALG.frm")
            .Import (lcPath + "CHOOSE_TYPE.frm")
            .Import (lcPath + "FORMULAEDIT.frm")
            .Import (lcPath + "LIST_FORMULA.frm")
            .Import (lcPath + "PART_CONDEDIT.frm")
            .Import (lcPath + "PART_FORMULAEDIT.frm")
            .Import (lcPath + "SEEK_POP.frm")
            .Import (lcPath + "cellsProperty.frm")
	#End If
   End With
   Call Start_Template
Exit Sub
doError:
    MsgBox "Ошибка " + VBA.str(ERR.Number) + ". " + ERR.Description + ", функция Import_File ", vbCritical, "Ошибка в программе"
    Resume Next
End Sub
' -------------------------------------------------------------------------------------------------------
' Модуль подготовки шаблона
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub Start_Template()
Dim oldbook, i, c As Object
Dim lcFileName, lcPath As String
    
    On Error GoTo doError
    lcFileName = ThisWorkbook.Sheets("start").Range("A1")
    Set oldbook = ThisWorkbook
    lcPath = ThisWorkbook.Sheets("start").Range("A2")
    Workbooks.Open filename:=lcPath + lcFileName + ".xlt", Editable:=True  '
    ThisWorkbook.Saved = True
    ThisWorkbook.Windows(1).Visible = False
    With Application.Workbooks(lcFileName + ".xlt")
        .Sheets("Service").Range("A36") = 1
        .Sheets("Service").Range("A37") = 1
        .Sheets("Service").Range("A38") = 1
        .Sheets("Service").Range("A3") = oldbook.Sheets("start").Range("A5")
        .Sheets("Service").Range("A4") = oldbook.Sheets("start").Range("A4")
        .Sheets("Service").Range("A5") = oldbook.Sheets("start").Range("A6")
        .Sheets("Service").Range("A6") = oldbook.Sheets("start").Range("A10")
        .Sheets("Service").Range("A15") = oldbook.Sheets("start").Range("A11")
        .Sheets("Service").Range("C1") = oldbook.Sheets("start").Range("A7")
        .Sheets("Service").Range("C2") = oldbook.Sheets("start").Range("A8")
        .Sheets("Service").Range("C3") = oldbook.Sheets("start").Range("A9")
        .Sheets("Service").Range("A33") = lcPath + "modules\"
        .Sheets("Service").Range("A27") = lcPath
        .Sheets("Service").Range("A26") = lcFileName
        .Sheets("Service").Range("A22") = oldbook.Sheets("start").Range("A22") 'EdiS признак авторизации
        oldbook.Sheets("start").Range("A10") = ""
        For Each i In .VBProject.VBComponents
            If (i.name = "SEEK_POP") Or (i.name = "SQLSERVER") Then
                Set c = i
                .VBProject.VBComponents.Remove (c)
            End If
        Next
      	#If Win64 Then
            'не грузим форму
	#Else
            .VBProject.VBComponents.Import (oldbook.Sheets("Start").Range("A3") + "SEEK_POP.frm")
	#End If
        .VBProject.VBComponents.Import (oldbook.Sheets("Start").Range("A3") + "SQLSERVER.bas")
        .Activate
    End With
    Call InitVars_Template
    pbShablon = True
    Call TOOLBAR_INIT
    Call MENU_INIT
    Call EDIT_TEMPLATE
Exit Sub
doError:
    Call ERROR_EVENT("Start_Template")
End Sub
' -------------------------------------------------------------------------------------------------------
' Модуль иницилизации переменных
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Sub InitVars_Template()
    
    On Error GoTo doError
    With Application.ActiveWorkbook.Sheets("Service")
        pnAddress_Row = .Range("C5")    'с какой записи
        pnAddress_Col = .Range("C6")    'с какой колонки
        Sheets("Service").Range("A37").Value = 1
        Sheets("Service").Range("A38").Value = 1
        pbShablon = True    'данные для выборки (хранимой процедуры)
        pcNameApp = .Range("C1")
    End With
Exit Sub
doError:
    Call ERROR_EVENT("InitVars_Template")
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 Win64 Then
        Call MsgBox("В данной версии MS Excel редактирование бланка отчета не поддерживается!!!", vbOKOnly + vbCritical, "Внимание!")
    #Else
        With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Добавить строку
            .FaceId = 213
            .Style = msoButtonIcon
            .Caption = "Добавить строку"
            .OnAction = "AddString"
        End With
        With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Редактировать строку
            .FaceId = 162
            .Style = msoButtonIcon
            .Caption = "Отредактировать строку"
            .OnAction = "EditString"
        End With
        With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Удалить строку
            .FaceId = 214
            .Style = msoButtonIcon
            .Caption = "Удалить строку"
            .OnAction = "DeleteString"
        End With
        With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Редактировать формулы контроля
            .FaceId = 477
            .Style = msoButtonIcon
            .Caption = "Формулы контроля"
            .OnAction = "LISTS_FORMULA"
        End With
        With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Редактировать условия отбора
            .FaceId = 702
            .Style = msoButtonIcon
            .Caption = "Алгоритм расчета"
            .OnAction = "ALG_CALCULATE"
        End With
    	With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Вывод алгоритмов отбора в файл
            .FaceId = 2648
            .Style = msoButtonIcon
            .Caption = "Вывод алгоритмов отбора в файл"
            .OnAction = "print_COND"
   	 End With
	    With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Вывод формул в файл
            .FaceId = 1034
            .Style = msoButtonIcon
            .Caption = "Вывод формул в файл"
            .OnAction = "print_FORM"
    	End With
        With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Обновление условий расчета из шаблона
            .FaceId = 2170
            .Style = msoButtonIcon
            .Caption = "Обновление условий расчета из шаблона"
            .OnAction = "UPDATE_COND"
        End With
    #End If
    With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Сохранение шаблона документа
        .FaceId = 3
        .Style = msoButtonIcon
        .Caption = "Сохранить бланк отчета"
        .OnAction = "SAVE_TEMPLATE"
    End With
    With ToolbarAction.Controls.Add(Type:=msoControlButton) 'Обновление серверной части шаблона
        .FaceId = 610
        .Style = msoButtonIcon
        .Caption = "Обновление серверной части шаблона"
        .OnAction = "UPDATE_SQL_TEMPLATE"
        End With
    With ToolbarAction.Controls.Add(Type:=msoControlButton) 'О программе
        .FaceId = 2104
        .Style = msoButtonIcon
        .Caption = "О программе"
        .OnAction = "SHOW_ABOUT"
    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
Dim 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 = "&Бланк"
    With www.Controls.Add(Type:=msoControlButton, id:=3, Before:=1)
        .OnAction = "SAVE_TEMPLATE"
    End With
    With www.Controls.Add(Type:=msoControlButton, id:=752, Before:=2)
        .OnAction = "EXIT_TEMPLATE"
    End With
    #If Win64 Then
     'Call MsgBox("В версии MS Excel редактирование бланка отчета невозможно!!!", vbOKOnly + vbCritical, "Внимание!")
    #ELSE
        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 = "&Настройка бланка"
        With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=1)
            .Caption = "&Добавить строку отчета"
            .OnAction = "ADDSTRING"
        End With
        With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=2)
            .Caption = "&Изменить строку отчета"
            .OnAction = "EDITSTRING"
        End With
        With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=3)
            .Caption = "&Удалить строку отчета"
            .OnAction = "DELETESTRING"
        End With
        With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=4)
            .Caption = "&Формулы контроля"
            .BeginGroup = True
            .OnAction = "LISTS_FORMULA"
        End With
        With www.Controls.Add(Type:=msoControlButton, id:=2949, Before:=5)
            .Caption = "&Алгоритм расчета"
            .OnAction = "ALG_CALCULATE"
        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
    #End If	
    For i = 1 To Application.CommandBars.count
        Application.CommandBars(i).Enabled = False
    Next
    Application.CommandBars("Строка меню отчета").Enabled = True
    Application.CommandBars("Строка меню отчета").Visible = True
    Application.DisplayFormulaBar = False
    ToolbarAction.Enabled = True
    ToolbarAction.Visible = True
    Application.OnKey "+^%{a}", "main.xls!admin"
    Application.OnKey "+^%{s}", "main.xls!ShowLists"
    Application.OnKey "+^%{h}", "main.xls!HideLists"
    Application.OnKey "%{f}", "main.xls!finteh"
    Exit Sub
doError:
    Call ERROR_EVENT("MENU_INIT")
End Sub
' -------------------------------------------------------------------------------------------------------
' Модуль ABOUT
' EdiS\07.10.10\bugs-16042
' -------------------------------------------------------------------------------------------------------
Public Sub SHOW_ABOUT()
    Call MsgBox("Используется шаблон" + vbNewLine + Application.ActiveWorkbook.path + "\" + Application.ActiveWorkbook.name, vbOKOnly + vbInformation, "О программе")
End Sub
' -------------------------------------------------------------------------------------------------------