' module: ÝòàÊíèãà

Attribute VB_Name = "ÝòàÊíèãà"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_Open()

    Application.ActiveWorkbook.Unprotect Password:="30616-3"
    Application.DisplayAlerts = False
    ActiveWorkbook.Worksheets("form").Delete
    ActiveWorkbook.Worksheets.Add
    ActiveWorkbook.Worksheets("Ëèñò1").Name = "form"

    If ActiveWorkbook.Worksheets("WARNING").Visible = True Then
        ActiveWorkbook.Worksheets("WARNING").Visible = False
    End If

    Application.DisplayAlerts = True

    'ThisWorkbook.VBProject.References.AddFromGuid GUID:="{0002E157-0000-0000-C000-000000000046}", Major:=5, Minor:=3

    Call Change_warnings

End Sub
Sub Change_warnings()
    Dim objExcelApp As Object, objShell As Object, sExVersion As String, lLevel As Long

    Set objExcelApp = CreateObject("Excel.Application")
    sExVersion = objExcelApp.Version: objExcelApp.Quit

    Set objShell = CreateObject("WScript.Shell")
    lLevel = objShell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Office\" & sExVersion & "\Excel\Security\VBAWarnings", 1, "REG_DWORD")

    Set objExcelApp = Nothing: Set objShell = Nothing
    Call Check_VBOM
End Sub
Sub Check_VBOM()
    Dim oVBProj As Object
    On Error Resume Next
    Set oVBProj = ActiveWorkbook.VBProject
    If Not oVBProj Is Nothing Then
        Call setDefaultParams
        Call mainProc 'main_proc
    Else
        MsgBox "Äîñòóï ê îáúåêòíîé ìîäåëè ïðîåêòîâ VBA çàïðåùåí", vbInformation
        ActiveWorkbook.Worksheets("WARNING").Visible = True
        ActiveWorkbook.Worksheets("WARNING").Activate
        ActiveWorkbook.Worksheets("form").Visible = False
    End If
End Sub



' module: main

Attribute VB_Name = "main"
Option Explicit
Sub mainProc()
    'Call setDefaultParams
    If prepareTest Then
        Exit Sub
    Else
        Select Case Replace(Replace(ActiveWorkbook.Names("form_type"), "=", ""), """", "")
            Case "Ôóíêöèîíàëüíûå"

                'ActiveWorkbook.Worksheets("_HELP_").Visible = False

                If ActiveWorkbook.Worksheets("_HELP_").Visible = True Then
                    ActiveWorkbook.Worksheets("_HELP_").Visible = False
                End If

                If ActiveWorkbook.Worksheets("HELP_").Visible = False Then
                    ActiveWorkbook.Worksheets("HELP_").Visible = True
                End If

                Call constructFuncForm
                Call showValues(Replace(Replace(ActiveWorkbook.Names("curr_id"), "=", ""), """", ""))
                Call applicationEventsDisable
                Call CreateEventProcedure_WorkSheetChange
                Call insertButtons
                Call CreateEventProcedure_CommandButtonOnClick
                Call applicationEventsEnable
            Case "Îïåðàöèîííûå"
                ActiveWorkbook.Worksheets("HELP_").Visible = False

                If ActiveWorkbook.Worksheets("_HELP_").Visible = False Then
                    ActiveWorkbook.Worksheets("_HELP_").Visible = True
                End If
                Call constructOperForm
                Call insertButtons
                Call CreateEventProcedure_CommandButtonOnClick_OPER
                Call applicationEventsEnable
        End Select
    End If
End Sub
Private Function prepareTest() As Boolean
    Dim u As String
    Dim FormType As String

    u = LCase(Environ("username"))

' 1. Ïðîâåðêà âåðñèè ôàéëà
    If checkFormVer() Then
        'MsgBox "Version OK", vbInformation
    Else
        MsgBox "Âåðñèÿ ôàéëà íåàêòóàëüíà.", vbInformation
        prepareTest = True
        Exit Function
    End If

' 2. Ïðîâåðêà ïîëüçîâàòåëÿ
    If checkUser(u) Then
        'MsgBox "User OK", vbInformation
        ActiveWorkbook.Names.Add Name:="user", RefersTo:=u
    Else
        MsgBox "Ïîëüçîâàòåëü íå çàðåãèñòðèðîâàí.", vbInformation
        ActiveWorkbook.Names.Add Name:="user", RefersTo:=u
        prepareTest = True
        Exit Function
    End If

' 3. Ïîëó÷åíèå òèïà ôîðìû
    FormType = getFormType(u)
    If FormType <> "Not defined" Then
        'MsgBox ("FormType - " & FormType), vbInformation
        ActiveWorkbook.Names.Add Name:="form_type", RefersTo:=FormType
    Else
        'MsgBox ("Íå îïðåäåëåí òèï ôîðìû."), vbInformation
        UserForm1.Show
        'ActiveWorkbook.Names.Add Name:="form_type", RefersTo:=FormType
        'prepareTest = True
        'Exit Function
    End If

' 4. Ïðîâåðêà ïëàí/ôàêòà/ïðîãíîçà
    If getPeriodAndType() Then
        'MsgBox ("Ïåðèîä è òèï ÎÊ"), vbInformation
    Else
        prepareTest = True
        MsgBox ("Íå îïðåäåëåí ïåðèîä èëè òèï äàííûõ."), vbInformation
        Exit Function
    End If

    Call maxLockMonth(Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", ""))

    prepareTest = False
End Function
Private Function checkFormVer() As Integer
    Dim sQry As String
    Dim result As Variant
    Dim form_ver As String

    sQry = "select form_ver from work.kh.protect where protect = 0 and is_actual = 1 "

    form_ver = Replace(Replace(ActiveWorkbook.Names("ver").Value, "=", ""), """", "")
    result = getRecordSet(sQry)

    If result(0, 0) = form_ver Then
        checkFormVer = 1
    Else
        checkFormVer = 0
    End If
End Function
Private Function checkUser(ByRef u As String) As Integer
    Dim sQry As String
    Dim result As Variant

    sQry = "select distinct a.user_log from work.kh.user_rules a where 1=1 and a.is_actual = 1 and user_log ='" & u & "'"

    result = getRecordSet(sQry)

    If LCase(result(0, 0)) = u Then
        checkUser = 1
    Else
        checkUser = 0
    End If
End Function
Private Function getFormType(ByRef u As String) As String
    Dim sQry As String
    Dim result As Variant

    sQry = "select distinct a.[type] from work.kh.rep_control a left join work.kh.user_rules b on a.id_dep = b.id_dep where 1 = 1 and b.is_actual = 1 and b.user_log = '" & u & "'"

    Debug.Print sQry

    result = getRecordSet(sQry)

    If UBound(result, 1) > 0 Or result(0, 0) = -1 Then
        getFormType = "Not defined"
    Else
        getFormType = result(0, 0)
    End If

End Function
Private Function getPeriodAndType() As Variant
    Dim sQry As String
    Dim result As Variant
    Dim i As Long, j As Long
    Dim arr(2) As Variant

    sQry = "select [type], [year] from work.kh.control_form where is_actual=1"
    result = getRecordSet(sQry)

    For i = LBound(result, 1) To UBound(result, 1)
        For j = LBound(result, 2) To UBound(result, 2)
            If result(i, j) = -1 Then
                getPeriodAndType = 0
                Exit Function
            Else
                arr(j) = result(i, j)
                getPeriodAndType = 1
            End If
        Next j
    Next i

    ActiveWorkbook.Names.Add Name:="paf", RefersTo:=arr(0)
    ActiveWorkbook.Names.Add Name:="year", RefersTo:=arr(1)

End Function
Sub setDefaultParams()
    ActiveWorkbook.Names.Add Name:="paf", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="attemp", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="user", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="year", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="form_type", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="lock_month", RefersTo:="0"
    ActiveWorkbook.Names.Add Name:="calc_var", RefersTo:="0"
End Sub
Private Function getRecordSet(ByRef sQry As String) As Variant
    Dim cn As ADODB.Connection
    Dim sCon As String
    Dim r_set As ADODB.Recordset
    Dim result As Variant

    Set cn = New ADODB.Connection
    Set r_set = New ADODB.Recordset

sCon = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial Catalog=work;Data Source=finsmeta01;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
'    sCon = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=SafinIKo;Password=111111;Data Source=DC1-FINDB01\FIN;ConnectionTimeout = 0; Commandtimeout = 0"
'    sCon = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=work;Data Source=DELL-PC\SQLEXPRESS;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=DELL-PC;Use Encryption for Data=False;Tag with column collation when possible=False"

    cn.Open sCon
    Set r_set = cn.Execute(sQry)

    If Not r_set.BOF Then
        result = r_set.GetRows
        result = rebuildArray(result)
    Else
        ReDim result(0, 0)
        result(0, 0) = -1
        r_set.Close
        cn.Close
        Set r_set = Nothing
        Set cn = Nothing
        getRecordSet = result
        Exit Function
    End If

    r_set.Close
    cn.Close
    Set r_set = Nothing
    Set cn = Nothing

    getRecordSet = result

End Function

Sub constructFuncForm()
    Dim r As Integer, c As Integer, i As Integer, j As Integer, o As Integer
    Dim sTitle As String
    Dim sQry As String
    Dim res As Variant

    Application.DisplayAlerts = False

    sQry = "select a.id_dep_parent as id, b.channel_type [dep_name], a.[type] from work.kh.rep_control a left join work.kh.sprv_channel b on a.id_dep = b.id_channel where rep_list  = 1 order by a.[type], b.channel_type"
    res = getRecordSet(sQry)

   ' Cells(1, 1) = res(1, 1)
    Range(Cells(1, 1), Cells(UBound(res, 1) + 1, UBound(res, 2) + 1)).Value = res

'    sQry = "select dep_name from work.kh.user_rules a left join work.kh.sprv_podr_type_new b on a.id_dep = b.id where 1=1 and user_log = '" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "' and b.type = '" & Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", "") & "' order by dep_name"
'    res = getRecordSet(sQry)

    ActiveSheet.UsedRange.Columns.AutoFit
    Rows(Cells(1, 1).Row).Insert Shift:=xlDown
    Rows(Cells(1, 1).Row).Insert Shift:=xlDown
    Rows(Cells(1, 1).Row).Insert Shift:=xlDown

    c = Cells(1, 1).End(xlDown).End(xlToRight).Offset(-1, 2).Column
    r = Cells(1, 1).End(xlDown).End(xlToRight).Offset(-1, 2).Row

    o = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown)).Rows.Count + 1

    sTitle = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")

    Select Case sTitle
        Case "actual"
            sTitle = "ÔÀÊÒ"
        Case "plan"
            sTitle = "ÏËÀÍ"
        Case "forecast"
            sTitle = "ÏÐÎÃÍÎÇ"
    End Select

    For i = 0 To 11
        Cells(r, c).Offset(0, i).Value = i + 1
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Interior.Color = RGB(221, 235, 247)
        Cells(r, c).Offset(0, i).Font.Color = RGB(47, 117, 181)
        Cells(r, c + i).Font.Bold = True

        Cells(r, c + i).Offset(-1, 0).Value = sTitle & " " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
        Cells(r, c).Offset(-1, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(-1, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(-1, i).Interior.Color = RGB(47, 117, 181)
        Cells(r, c).Offset(-1, i).Font.Color = RGB(221, 235, 247)
        Cells(r, c + i).Offset(-1, 0).Font.Bold = True

        Cells(r, c).Offset(o, i).Formula = "=Round(Sum(" & Range(Cells(r, c).Offset(1, i), Cells(r, c).Offset(o - 1, i)).Address & "),2)"
        Range(Cells(r, c).Offset(1, i), Cells(r, c).Offset(o - 1, i)).Style = "Percent"
        Cells(r, c).Offset(o, i).Style = "Percent"
        Cells(r, c).Offset(o, i).Font.Bold = True

        Cells(r, c).Offset(o, i).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=100%"
        Cells(r, c).Offset(o, i).FormatConditions(Cells(r, c).Offset(o, i).FormatConditions.Count).SetFirstPriority
        With Cells(r, c).Offset(o, i).FormatConditions(1).Font
            .Bold = True
            .Italic = False
            .Color = RGB(255, 255, 255)
            .TintAndShade = 0
        End With
        With Cells(r, c).Offset(o, i).FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = RGB(255, 0, 0)
            .TintAndShade = 0
        End With
        Cells(r, c).Offset(o, i).FormatConditions(1).StopIfTrue = False

        Cells(r, c).Offset(o, i).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0%"
        Cells(r, c).Offset(o, i).FormatConditions(Cells(r, c).Offset(o, i).FormatConditions.Count).SetFirstPriority
        With Cells(r, c).Offset(o, i).FormatConditions(1).Font
            .Bold = True
            .Italic = False
            .Color = RGB(0, 0, 0)
            .TintAndShade = 0
        End With
        With Cells(r, c).Offset(o, i).FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = RGB(255, 217, 102)
            .TintAndShade = 0
        End With
        Cells(r, c).Offset(o, i).FormatConditions(1).StopIfTrue = False


    Next i

    Range(Cells(r, c + i).Offset(-1, -1), Cells(r, c + i).Offset(-1, -1).End(xlToLeft)).Merge

    Columns(Cells(1, 1).Column).Font.Color = RGB(255, 255, 255)
    sQry = "select a.id_dep, b.channel_type, a.lock from work.kh.user_rules a left join work.kh.sprv_channel b on a.id_dep = b.id_channel left join work.kh.rep_control c on a.id_dep = c.id_dep where 1 = 1 and a.user_log = '" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "' and a.is_actual = 1 and c.[type] = '" & Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", "") & "'" & "order by b.channel_type"
    'sQry = "select id_dep, dep_name, lock from work.kh.user_rules a left join work.kh.sprv_podr_type_new b on a.id_dep = b.id where 1=1 and a.is_actual = 1 and user_log = '" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "' and b.[type] = '" & Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", "") & "' and dep_name is not null order by dep_name"
    Debug.Print sQry
    res = getRecordSet(sQry)

    Range(Cells(1, 29), Cells(UBound(res, 1) + 1, 31)).Font.Color = RGB(255, 255, 255)
    Range(Cells(1, 29), Cells(UBound(res, 1) + 1, 31)) = res
    ActiveWorkbook.Names.Add Name:="dep_list", RefersTo:="=form!" & Range(Cells(1, 30), Cells(UBound(res, 1) + 1, 30)).Address
    ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:=Cells(1, 29).Value

    Range(Cells(1, 1).End(xlDown).Offset(-2, 1).Address).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=dep_list"
    Cells(1, 1).End(xlDown).Offset(-2, 1) = Cells(1, 30)

    Cells(1, 1).End(xlDown).Offset(-2, 1).Interior.Color = RGB(255, 242, 204)
    Cells(1, 1).End(xlDown).Offset(-2, 1).Font.Bold = True
    Cells(1, 1).End(xlDown).Offset(-2, 1).Borders.LineStyle = xlContinuous

    ActiveWindow.DisplayGridlines = False

    Rows(Cells(1, 1).Row).RowHeight = 6
    Columns(Cells(1, 1).Column).ColumnWidth = 0.73


    Application.DisplayAlerts = True

End Sub
Private Function rebuildArray(ByVal arr As Variant) As Variant
    Dim i As Long, j As Long
    Dim a As Integer
    Dim res As Variant

    ReDim res(0 To UBound(arr, 2), 0 To UBound(arr, 1))

    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            res(j, i) = arr(i, j)
        Next j
    Next i
    rebuildArray = res
End Function

Sub showValues(ByVal i_id As Long)
    Dim sQry As String
    Dim val() As Variant
    Dim val1() As Variant
    Dim mnth() As Variant
    Dim scenario As Integer
    Dim deps() As Variant
    Dim i As Long, j As Long, k As Long, z As Long, n As Long 'Âñïîìîãàòåëüíûå ïåðåìåííûå äëÿ ðàçíûõ öèêëîâ (â îñíîâíîì äëÿ ïåðåáîðà çíà÷åíèé)

    ActiveSheet.Unprotect Password:="30616-3"

    '-=Î÷èùàåì ôîðìó îò ïðåäûäóùèõ çíà÷åíèé (ïëîõî ñäåëàíî - ïðèñóòñâóþò magic numbers)=-'
    Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, 2).End(xlToRight).Offset(-1, 0)).ClearContents
    Range(Cells(1, 1).End(xlDown).End(xlDown).Offset(3, 4), Cells(1, 1).End(xlDown).End(xlDown).Offset(1, 4).End(xlToRight).Offset(2, 0)).ClearContents

    If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
        scenario = 1
    ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
        scenario = 2
    End If

    sQry = "select dt, id_recipient, value " _
            & "from work.kh.user_form_driver_func a " _
            & "where 1 = 1 " _
            & "and scenario = " & scenario _
            & "and is_actual = 1" _
            & "and id_source = " & i_id _
            & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "and value <> 0 " _
            & "order by dt"


  '  sQry = "select dt, id, [%%] from work.kh.user_form_func " _
  '          & "where 1 = 1 and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' and actual = 1 " _
  '          & "and id_source in (" & i_id & ") and year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " order by dt"

    deps = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown))
    val = getRecordSet(sQry)

    j = 0
    z = 0

    ReDim Preserve mnth(0)
    If val(0, 0) = -1 Then
        Call lockForm
        MsgBox ("Íåò äàííûõ!")
        Exit Sub
    Else
        mnth(0) = Month(val(0, 0))
    End If

    '-=Çàïîëíÿåì ìàññèâ óíèêàëüíûìè äàòàìè, ïðèñóòñòâóþùèõ â çàíåñåííûõ ðàíåå äàííûõ=-'
    For i = 0 To UBound(val) - 1
        If val(z, 0) <> val(i + 1, 0) Then
            z = i + 1
            j = j + 1
            ReDim Preserve mnth(j)
            mnth(j) = Month(val(i + 1, 0))
        End If
    Next i

    '-=Ñîçäàåì ìàññèâ äëÿ õðàíåíèÿ èòîãîâûõ ðåçóëüòàòîâ=-'
    val1 = deps

    '-=Çàïîëíÿåì ìàññèâ çíà÷åíèÿìè=-'
    For k = 0 To UBound(mnth, 1)
        For i = 1 To UBound(deps, 1)
            For j = 0 To UBound(val, 1)
                If deps(i, 1) = val(j, 1) And mnth(k) = Month(val(j, 0)) Then
                    val1(i, 1) = val(j, 2)
                    Exit For
                Else
                    val1(i, 1) = ""
                End If
            Next j
        Next i

        '-=Âûâîäèì ðåçóëüòàò íà ëèñò=-'
        For n = 1 To 12

            If Cells(1, 1).End(xlDown).Offset(-1, 3 + n).Value = mnth(k) Then
                'Cells(1, 1).End(xlDown).End(xlDown).Offset(3, 3 + n).Value = mnth(k)
                Range(Cells(1, 1).End(xlDown).Offset(0, 2), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown)).Offset(0, n + 1) = val1
                Exit For
            End If
        Next n
    Next k
Call lockForm
End Sub
Sub lockForm()
    Dim i As Integer, j As Integer
    Dim sTitle As String
    Dim qty As Integer
    Dim lockmonth As Integer

    lockmonth = Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")
    qty = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown)).Rows.Count
    i = 2
    j = 0

ActiveSheet.Unprotect Password:="30616-3"
'Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Select

'Ïðîñòàâëÿåì ôëàã 1 äëÿ çàêðûòûõ ïåðèîäîâ
Do While Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Value <> ""
    If Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Offset(-1 - qty, 0).Value <= lockmonth Then
        Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(3, i).Value = 1
    End If
    i = i + 1
Loop

 i = 2
    Do While Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Value <> ""
        If Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(3, i).Value = 1 Then
            Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
            Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(3, i).Font.Color = RGB(255, 255, 255)
            j = i + 1
        End If
        i = i + 1
    Loop

    Cells(1, 1).End(xlDown).Offset(-2, 1).Locked = False

    Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, i - 1)).Locked = False
    Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, i - 1)).Interior.Color = RGB(255, 242, 204)
    Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, i - 1)).Font.Color = RGB(0, 0, 0)

    With Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, i - 1)).Validation
        .Delete
        .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween, Formula1:="0", Formula2:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

    If lockmonth <> 0 Then
        Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, j - 1)).Interior.Color = RGB(231, 230, 230)
        Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, j - 1)).Font.Color = RGB(128, 128, 128)
        Range(Cells(1, 1).End(xlDown).Offset(0, 4), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(0, j - 1)).Locked = True
        Range(Cells(1, 1).End(xlDown).Offset(0, 2), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown)).Offset(0, 1).ClearContents
    End If

    Call test

End Sub

Sub test()
    Dim i_id As Long, start_row As Long, st_row As Long, i_id2 As Long
    Dim i As Long, r_max As Long
    Dim r As Long

    i_id = Replace(Replace(ActiveWorkbook.Names("curr_id"), "=", ""), """", "")

    start_row = Cells(1, 31).Row

    Do While Cells(start_row, 31).Value <> ""
        If Cells(start_row, 31).Offset(0, -2).Value = i_id Then
            st_row = Cells(1, 1).End(xlDown).Row
            i_id2 = Cells(start_row, 31).Value
            Do While Cells(st_row, 1).Value <> ""
                If Cells(st_row, 1).Value = i_id2 Then
                    Cells(st_row, 1).Offset(0, 3).Value = 1
                    Exit Do
                End If
                st_row = st_row + 1
            Loop
            Exit Do
        End If
        start_row = start_row + 1
    Loop

    i = 0

    r_max = Cells(1, 1).End(xlDown).End(xlDown).Row

    Do While i <= r_max
        If Cells(1, 1).End(xlDown).Offset(i, 3) = 1 Then
            Range(Cells(1, 1).End(xlDown).Offset(i, 3).EntireRow.Address).Locked = True
            r = Cells(1, 1).End(xlDown).Offset(i, 3).Row
            Range(Cells(r, 2), Cells(r, 3)).Interior.Color = RGB(255, 204, 204)
            Range(Cells(r, 2), Cells(r, 3)).Font.Color = RGB(255, 0, 0)

            Range(Cells(r, 2).Offset(0, 3), Cells(r, 2).Offset(0, 14)).Interior.Color = RGB(231, 230, 230)
            Range(Cells(r, 2).Offset(0, 3), Cells(r, 2).Offset(0, 14)).Font.Color = RGB(255, 0, 0)

        Else
            r = Cells(1, 1).End(xlDown).Offset(i, 3).Row
            Range(Cells(r, 2), Cells(r, 3)).Interior.Color = xlNone
            Range(Cells(r, 2), Cells(r, 3)).Font.Color = RGB(0, 0, 0)
        End If
        i = i + 1
    Loop

    Range("D:D").ClearContents
    Range("D:D").ColumnWidth = 1.33
    Range("D:D").Font.Color = RGB(255, 255, 255)

    ActiveSheet.Protect Password:="30616-3"

End Sub

Sub CreateEventProcedure_WorkSheetChange()
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long

    'ïîëó÷àåì ññûëêó íà ïðîåêò è ìîäóëü ëèñòà
    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("Ëèñò1")
    Set objCodeMod = objVBComp.CodeModule
    'âñòàâëÿåì êîä
    With objCodeMod
        lLineNum = .CreateEventProc("Change", "Worksheet")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "Dim KeyCells As Range" & Chr(10) _
                                    & "Dim iid As Long" & Chr(10) _
                                    & "Dim s As String" & Chr(10) _
                                    & "Dim i As Integer" & Chr(10) _
                                    & "Set KeyCells = Cells(1, 1).End(xlDown).Offset(-2, 1)" & Chr(10) _
                                    & "If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then" & Chr(10) _
                                    & "i = 1" & Chr(10) _
                                    & "s = KeyCells.Value" & Chr(10) _
                                    & "Do While Cells(i, 30).Value <> """" " & Chr(10) _
                                    & "If Cells(i, 30).Value = s Then" & Chr(10) _
                                    & "iid = Cells(i, 30).Offset(0, -1).Value" & Chr(10) _
                                    & "Exit Do" & Chr(10) _
                                    & "End If" & Chr(10) _
                                    & "i = i + 1" & Chr(10) _
                                    & "Loop" & Chr(10) _
                                    & "ActiveWorkbook.Names.Add Name:=""curr_id"", RefersTo:=iid" & Chr(10) _
                                    & "Call showValues(iid)" & Chr(10) _
                                    & "End If" & Chr(10)
    End With

    Set objVBProj = Nothing
    Set objVBComp = Nothing
    Set objCodeMod = Nothing

End Sub
Sub insertButtons()
    ActiveSheet.Unprotect Password:="30616-3"
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
        , DisplayAsIcon:=False, Left:=950, Top:=5, Width:=80, Height:=24) _
        .Select
    ActiveSheet.OLEObjects("CommandButton1").Object.Caption = "Çàãðóçèòü äàííûå"
    ActiveSheet.Protect Password:="30616-3"
    Application.ActiveWorkbook.Protect Password:="30616-3"
End Sub
Sub CreateEventProcedure_CommandButtonOnClick()
 Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long

    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("Ëèñò1")
    Set objCodeMod = objVBComp.CodeModule

    With objCodeMod
        lLineNum = .CreateEventProc("Click", "CommandButton1")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "ActiveWorkbook.Names.Add Name:=""attemp"", RefersTo:=""1""" & Chr(10) _
         & "Call checkData" & Chr(10)
    End With

    ActiveWorkbook.VBProject.VBE.MainWindow.Visible = False

    Set objVBProj = Nothing
    Set objVBComp = Nothing
    Set objCodeMod = Nothing
End Sub
Sub CreateEventProcedure_CommandButtonOnClick_OPER()
 Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long

    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("Ëèñò1")
    Set objCodeMod = objVBComp.CodeModule

    With objCodeMod
        lLineNum = .CreateEventProc("Click", "CommandButton1")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "ActiveWorkbook.Names.Add Name:=""attemp"", RefersTo:=""1""" & Chr(10) _
         & "Call checkData_1" & Chr(10)
    End With

    ActiveWorkbook.VBProject.VBE.MainWindow.Visible = False

    Set objVBProj = Nothing
    Set objVBComp = Nothing
    Set objCodeMod = Nothing
End Sub
Sub applicationEventsEnable()
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub
Sub applicationEventsDisable()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
End Sub
Sub checkData()
    Dim ch0 As Double
    Dim ch1 As Double
    Dim r As Integer, c As Integer, qty As Integer, c1 As Integer, r1 As Integer, i As Integer
    Dim m As String
    Dim dt As Date
    Dim s_dt As String
    Dim i_err As Integer
    Dim check_value As Double
    Dim sQry As String
    Dim scenario As Integer


     If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
        scenario = 1
     ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
        scenario = 2
     End If

    ch0 = 0
    ch1 = 1

    qty = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown)).Rows.Count

    r = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Row
    c = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Column

    Do While Cells(r, c).Value = 1
        c = c + 1
    Loop

    If c = 17 Then
        MsgBox ("Äàííûå çàáëîêèðîâàíû äëÿ èçìåíåíèÿ"), vbInformation
        Exit Sub
    End If

    c1 = c
    r = Cells(r, c).Offset(-2, 0).Row
    r1 = r



    Do While Cells(r, c).Value <> ""
   check_value = Round(Cells(r, c).Value, 9)
        If check_value > ch0 Then
            m = Cells(r, c).Offset(-qty - 1, 0).Value
            dt = "01." & m & "." & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
            dt = DateAdd("d", -1, DateAdd("m", 1, dt))

            check_value = Round(Cells(r, c).Value, 9)

            If check_value <> ch1 Then
                s_dt = s_dt & Chr(10) & "    *" & Format(dt, "mmmm yyyy")
                i_err = 1
            End If
        End If
        c = c + 1
    Loop

    If i_err = 1 Then
        MsgBox ("Çíà÷åíèÿ íå ðàâíî 100%" & Chr(10) & "Ïåðèîä:" & s_dt), vbCritical
        Exit Sub
    Else
    check_value = Round(Cells(r1, c1).Value, 9)
        If check_value = ch0 Then
            m = Cells(r1, c1).Offset(-qty - 1, 0)
            dt = "01." & m & "." & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
            dt = DateAdd("d", -1, DateAdd("m", 1, dt))
            MsgBox ("Íåò äàííûõ çà:" & Chr(10) & "    *" & Format(dt, "mmmm yyyy")), vbCritical
            Exit Sub
        End If
    End If

'---------------------------------------------------------------------------------------------

    r = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Row
    c = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Column

    Do While Cells(r, c).Value = 1
        c = c + 1
    Loop

'    If c = 5 Then
'        c = Month(Date) + 3
'    End If

    c1 = c
    r = Cells(r, c).Offset(-2, 0).Row
    r1 = r

    Do While Cells(r, c).Value <> ""
        If Round(Cells(r, c).Value, 9) > ch0 Then
            m = Cells(r, c).Offset(-qty - 1, 0).Value
            dt = "01." & m & "." & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
            dt = DateAdd("d", -1, DateAdd("m", 1, dt))

            check_value = Round(Cells(r, c).Value, 9)

            If check_value = ch1 Then
                s_dt = s_dt & Chr(10) & "    *" & Format(dt, "mmmm yyyy")

                i = Cells(1, 1).End(xlDown).Row

        '                sQry = "delete " _
        '                        & "from work.kh.user_form_func " _
        '                        & "where 1 = 1 " _
        '                        & "and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
        '                        & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
        '                        & "and actual = 0 " _
        '                        & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' "

                        sQry = "delete " _
                                & "from work.kh.user_form_driver_func " _
                                & "where 1 = 1 " _
                                & " and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
                                & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
                                & " and is_actual = 0 " _
                                & " and scenario = " & scenario


                        Debug.Print sQry
                        Call executeSQL(sQry)

'                        sQry = "update a " _
'                                & "set a.actual = 0 " _
'                                & "from work.kh.user_form_func a " _
'                                & "where 1 = 1 " _
'                                & "and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
'                                & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
'                                & "and actual = 1 " _
'                                & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' "

                        sQry = "update a " _
                                & "set a.is_actual = 0 " _
                                & "from work.kh.user_form_driver_func a " _
                                & "where 1 = 1 " _
                                    & " and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
                                    & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
                                    & " and is_actual = 1 " _
                                    & " and scenario = " & scenario


                        Debug.Print sQry
                        Call executeSQL(sQry)

                Do While Cells(i, 1).Value <> ""
                    If Cells(i, 1).Offset(0, c - 1).Value <> "" Then

                        sQry = "insert into work.kh.user_form_driver_func (dt, id_source, id_recipient, value, dt_add, [user_name], scenario, is_actual) values (" _
                                & "'" & Format(dt, "yyyy-mm-dd") & "'," & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "," & Cells(i, 1).Value & "," _
                                & Replace(Cells(i, 1).Offset(0, c - 1).Value, ",", ".") & ", getdate(), " _
                                & "'" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "'," _
                                & scenario & "," _
                                & 1 & ")"

                        Debug.Print sQry
                        Call executeSQL(sQry)
                    End If
                    i = i + 1
                Loop
            End If
        End If
        c = c + 1
    Loop

    MsgBox ("Çàãðóæåíû äàííûå çà:" & s_dt), vbInformation

End Sub
Sub maxLockMonth(ByVal form_type As String)
    Dim sQry As String
    Dim m As Variant
    Dim s As String
    Dim scenario As Integer


    If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "forecast" Then
        s = "actual"
    Else
        s = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
    End If


    If s = "actual" Then
        scenario = 2
    ElseIf s = "plan" Then
        scenario = 1
    End If

    If form_type = "Îïåðàöèîííûå" Then

    sQry = "select isnull(month(max(dt)),-1) m " _
            & "from work.kh.user_form_driver_oper " _
            & "where 1 = 1 " _
            & "and is_actual = 1 " _
            & "and scenario = " & scenario & " " _
            & "and lock_period is not null " _
            & "and year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")

    Debug.Print sQry

    Else

    sQry = "select isnull(month(max(dt)),-1) m " _
            & "from work.kh.user_form_driver_func " _
            & "where 1 = 1 " _
            & "and is_actual = 1 " _
            & "and scenario = '" & scenario & "' " _
            & "and lock_period is not null " _
            & "and year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")

    End If

    m = getRecordSet(sQry)

    If m(0, 0) = -1 Then
        ActiveWorkbook.Names.Add Name:="lock_month", RefersTo:="0"
    Else
        ActiveWorkbook.Names.Add Name:="lock_month", RefersTo:=m(0, 0)
    End If
End Sub

Sub executeSQL(ByRef sQry)
    Dim cn As ADODB.Connection
    Dim sCon As String

   ' sCon = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=SafinIKo;Password=111111;Data Source=DC1-FINDB01\FIN;ConnectionTimeout = 0; Commandtimeout = 0"
  sCon = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial Catalog=work;Data Source=finsmeta01;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
    Set cn = New ADODB.Connection

    cn.Open sCon
    cn.Execute sQry

End Sub
Sub constructOperForm()
    Call construct_1
    Call construct_2
    Call CreateEventProcedure_WorkSheetChange_Oper
    Call showValuesOper
End Sub

Sub construct_1()
    Dim n As Variant
    Dim sTitle As String
    Dim r As Long
    Dim rr As Long
    Dim cc As Long
    Dim c As Long
    Dim i As Long
    Dim sQry As String

    Application.DisplayAlerts = False
    ActiveSheet.Unprotect Password:="30616-3"

    'Ðàññòàâëÿåì êîíòðîëüíûå òî÷êè
    ActiveWorkbook.Names.Add Name:="product", RefersTo:="=form!" & Range("C6").Address
    sQry = "select b.id_channel, a.name from work.kh.sprv a left join work.kh.sprv_channel b on a.name = b.channel_type where 1 = 1 and " _
            & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
            & "and a.[type] = 'product' " _
            & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "order by name"


    n = getRecordSet(sQry)
    r = Range("product").Offset(1, 0).Row
    c = Range("product").Offset(1, 0).Column
    Range(Cells(r, c + 1), Cells(UBound(n, 1) + r, c)).Offset(0, -1) = n

    ActiveWorkbook.Names.Add Name:="channel_type", RefersTo:="=form!" & Range("product").Offset(1, 0).End(xlDown).Offset(3, 0).Address

    sQry = "select b.id_channel, a.name from work.kh.sprv a left join work.kh.sprv_channel b on a.name = b.channel_type where 1 = 1 and " _
            & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
            & "and a.[type] = 'channel_type' " _
            & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "order by name"

    n = getRecordSet(sQry)
    r = Range("channel_type").Offset(1, 0).Row
    c = Range("channel_type").Offset(1, 0).Column
    Range(Cells(r, c + 1), Cells(UBound(n, 1) + r, c)).Offset(0, -1) = n


'    rr = Range("channel_type").Row
'    cc = Range("channel_type").Column
'
'    'Cells(rr, cc).Select
'
'    Do While Cells(rr + 1, cc).Value <> ""
'        If Cells(rr + 1, cc).Value = "Á" Then
'            Cells(rr + 1, cc).EntireRow.Insert
'            Cells(rr + 1, cc).Value = "test"
'            Cells(rr + 1, cc).Font.Color = RGB(255, 255, 255)
'        Exit Do
'        End If
'        rr = rr + 1
'    Loop
'

    ActiveWorkbook.Names.Add Name:="channel_call", RefersTo:="=form!" & Range("channel_type").Offset(1, 0).End(xlDown).Offset(3, 0).Address

    sQry = "select b.id_channel, a.name from work.kh.sprv a left join work.kh.sprv_channel b on a.name = b.channel_type where 1 = 1 and " _
            & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
            & "and a.[type] = 'channel_call' " _
            & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "order by name"

    n = getRecordSet(sQry)
    r = Range("channel_call").Offset(1, 0).Row
    c = Range("channel_call").Offset(1, 0).Column
    Range(Cells(r, c + 1), Cells(UBound(n, 1) + r, c)).Offset(0, -1) = n
    '--------------------------------------------------------
    sTitle = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
    Select Case sTitle
    Case "actual"
        sTitle = "ÔÀÊÒ"
    Case "plan"
        sTitle = "ÏËÀÍ"
    Case "forecast"
        sTitle = "ÏÐÎÃÍÎÇ"
    End Select

    r = Range("product").Row
    c = Range("product").Column

    For i = 1 To 12
        Cells(r, c).Offset(-2, i).Value = sTitle & " " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
        Cells(r, c).Offset(-2, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(-2, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(-2, i).Interior.Color = RGB(68, 114, 196)
        Cells(r, c).Offset(-2, i).Font.Color = RGB(221, 235, 247)
        Cells(r, c).Offset(-2, i).Font.Bold = True

        Cells(r, c).Offset(-1, i).Value = i
        Cells(r, c).Offset(-1, i).Interior.Color = RGB(221, 235, 247)
        Cells(r, c).Offset(-1, i).Font.Color = RGB(68, 114, 196)
        Cells(r, c).Offset(-1, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(-1, i).VerticalAlignment = xlCenter


        Cells(r, c).Offset(0, i).Value = "Ìàêðîïðîäóêò"
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Font.Bold = True
        Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)

        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
        Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Formula = "=SUM(" & Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Address & ")"

        Cells(r, c).Offset(0, i).EntireColumn.ColumnWidth = 6.17

        If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        Else
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(255, 242, 204)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(255, 217, 102)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False

            With Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Validation
                .Delete
                .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
                :=xlBetween, Formula1:="0", Formula2:="1"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With

            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions.Add Type:=xlExpression, Formula1:="=" & Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Address & ">1"
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions.Count).SetFirstPriority
            With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Font
                .Bold = True
                .Italic = False
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
            End With
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).StopIfTrue = False

        End If

    Next i

    Range(Cells(r, c).Offset(-2, 1), Cells(r, c).Offset(-2, 1).End(xlToRight)).Merge
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge

    r = Range("channel_type").Row
    c = Range("channel_type").Column

    For i = 1 To 12
        Cells(r, c).Offset(0, i).Value = "Êàíàë ïðîäàæ"
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Font.Bold = True
        Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
        Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Formula = "=SUM(" & Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).AddressLocal & ")"

        If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        Else
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(255, 242, 204)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(255, 217, 102)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False

            With Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Validation
                .Delete
                .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
                :=xlBetween, Formula1:="0", Formula2:="1"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With

            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions.Add Type:=xlExpression, Formula1:="=" & Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Address & ">1"
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions.Count).SetFirstPriority
            With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Font
                .Bold = True
                .Italic = False
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
            End With
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).StopIfTrue = False

        End If

    Next i

    Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge

    r = Range("channel_call").Row
    c = Range("channel_call").Column

    For i = 1 To 12
        Cells(r, c).Offset(0, i).Value = "Êàíàë ïðèâëå÷åíèÿ"
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Font.Bold = True
        Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
        Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Formula = "=SUM(" & Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Address & ")"

        If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        Else
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(255, 242, 204)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(255, 217, 102)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False

            With Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Validation
                .Delete
                .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
                :=xlBetween, Formula1:="0", Formula2:="1"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With

            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions.Add Type:=xlExpression, Formula1:="=" & Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Address & ">1"
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions.Count).SetFirstPriority
            With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Font
                .Bold = True
                .Italic = False
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 192
                .TintAndShade = 0
            End With
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).StopIfTrue = False

        End If

    Next i

    Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge


    Range("A:B").ColumnWidth = 1.83
    Columns("C:C").EntireColumn.AutoFit
    Rows("1:3").RowHeight = 12

    Columns("B:B").Font.Color = RGB(255, 255, 255)


End Sub
Sub construct_2()
     Dim n As Variant
    Dim sTitle As String
    Dim r As Long
    Dim rr As Long
    Dim cc As Long
    Dim c As Long
    Dim i As Long
    Dim sQry As String

    Application.DisplayAlerts = False
      ' Stop
    'Ðàññòàâëÿåì êîíòðîëüíûå òî÷êè
    ActiveWorkbook.Names.Add Name:="product_calc", RefersTo:="=form!" & Range("S6").Address
    sQry = "select name from work.kh.sprv where 1 = 1 and " _
            & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
            & "and [type] = 'product' " _
            & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "order by name"
    n = getRecordSet(sQry)
    r = Range("product_calc").Offset(1, 0).Row
    c = Range("product_calc").Offset(1, 0).Column
    Range(Cells(r, c), Cells(UBound(n, 1) + r, c)) = n

    ActiveWorkbook.Names.Add Name:="channel_type_calc", RefersTo:="=form!" & Range("product_calc").Offset(1, 0).End(xlDown).Offset(3, 0).Address
       sQry = "select name from work.kh.sprv where 1 = 1 and " _
            & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
            & "and [type] = 'channel_type' " _
            & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "order by name"
    n = getRecordSet(sQry)
    r = Range("channel_type_calc").Offset(1, 0).Row
    c = Range("channel_type_calc").Offset(1, 0).Column
    Range(Cells(r, c), Cells(UBound(n, 1) + r, c)) = n

    rr = Range("channel_type_calc").Row
    cc = Range("channel_type_calc").Column

    'Cells(rr, cc).Select

    Do While Cells(rr + 1, cc).Value <> ""
        If Cells(rr + 1, cc).Value = "Á" Then
            Cells(rr + 1, cc).EntireRow.Insert
            Cells(rr + 1, cc).Value = "Á1"
            Cells(rr + 2, cc).Value = "Á1_2"
            'Cells(rr + 1, cc).Font.Color = RGB(255, 255, 255)
        Exit Do
        End If
        rr = rr + 1
    Loop


    rr = Range("channel_type").Row
    cc = Range("channel_type").Column

    Cells(rr, cc).Select

    Do While Cells(rr + 1, cc).Value <> ""
        If Cells(rr + 2, cc).Value = "" Then
            Cells(rr + 2, cc).Select
            Cells(rr + 2, cc).Value = "test"

            Cells(rr + 2, cc).Font.Color = RGB(255, 255, 255)
            Range(Cells(rr + 2, cc + 1), Cells(rr + 2, cc + 12)).Locked = True
        Exit Do
        End If
        rr = rr + 1
    Loop


    ActiveWorkbook.Names.Add Name:="channel_call_calc", RefersTo:="=form!" & Range("channel_type_calc").Offset(1, 0).End(xlDown).Offset(3, 0).Address
    sQry = "select name from work.kh.sprv where 1 = 1 and " _
            & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
            & "and [type] = 'channel_call' " _
            & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
            & "order by name"
    n = getRecordSet(sQry)
    r = Range("channel_call_calc").Offset(1, 0).Row
    c = Range("channel_call_calc").Offset(1, 0).Column
    Range(Cells(r, c), Cells(UBound(n, 1) + r, c)) = n
    '--------------------------------------------------------
    sTitle = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
    Select Case sTitle
    Case "actual"
        sTitle = "ÔÀÊÒ"
    Case "plan"
        sTitle = "ÏËÀÍ"
    Case "forecast"
        sTitle = "ÏÐÎÃÍÎÇ"
    End Select


    r = Range("product_calc").Row
    c = Range("product_calc").Column

    For i = 1 To 12
        Cells(r, c).Offset(-2, i).Value = sTitle & " " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
        Cells(r, c).Offset(-2, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(-2, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(-2, i).Interior.Color = RGB(68, 114, 196)
        Cells(r, c).Offset(-2, i).Font.Color = RGB(221, 235, 247)
        Cells(r, c).Offset(-2, i).Font.Bold = True

        Cells(r, c).Offset(-1, i).Value = i
        Cells(r, c).Offset(-1, i).Interior.Color = RGB(221, 235, 247)
        Cells(r, c).Offset(-1, i).Font.Color = RGB(68, 114, 196)
        Cells(r, c).Offset(-1, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(-1, i).VerticalAlignment = xlCenter


        Cells(r, c).Offset(0, i).Value = "Ìàêðîïðîäóêò"
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Font.Bold = True
        Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)

        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
        Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Formula = "=SUM(" & Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Address & ")"

        Cells(r, c).Offset(0, i).EntireColumn.ColumnWidth = 6.17

        If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        Else
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(237, 237, 237)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
           ' Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False
        End If

    Next i

    Range(Cells(r, c).Offset(-2, 1), Cells(r, c).Offset(-2, 1).End(xlToRight)).Merge
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge

    r = Range("channel_type_calc").Row
    c = Range("channel_type_calc").Column

    For i = 1 To 12
        Cells(r, c).Offset(0, i).Value = "Êàíàë ïðîäàæ"
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Font.Bold = True
        Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
        Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Formula = "=SUM(" & Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).AddressLocal & ")"

        If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        Else
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(237, 237, 237)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        End If

    Next i

    Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge

    r = Range("channel_call_calc").Row
    c = Range("channel_call_calc").Column

    For i = 1 To 12
        Cells(r, c).Offset(0, i).Value = "Êàíàë ïðèâëå÷åíèÿ"
        Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
        Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
        Cells(r, c).Offset(0, i).Font.Bold = True
        Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
        Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
        Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Formula = "=SUM(" & Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Address & ")"

        If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        Else
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(237, 237, 237)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
            Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
            Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
        End If

    Next i

    Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge


    Application.DisplayAlerts = True


    Range("P:R").ColumnWidth = 1.57
    Columns("S:S").EntireColumn.AutoFit

    Application.DisplayAlerts = True

    sQry = "select a.id_dep, c.channel_type as dep_name, b.calc_var " _
            & "from work.kh.user_rules a " _
            & "left join work.kh.rep_control b on a.id_dep = b.id_dep " _
            & "left join work.kh.sprv_channel c on a.id_dep = c.id_channel " _
            & "where 1 = 1 " _
            & "and is_actual = 1 " _
            & "and user_log = '" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "' " _
            & "and b.[type] = '" & Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", "") & "' " _
            & "and b.calc_var <> 0"

    'sQry = "select id_dep, dep_name, scheme from work.kh.user_rules a left join work.kh.sprv_podr_type_new b on a.id_dep = b.id where 1=1 and a.is_actual = 1 and user_log = '" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "'and b.[type] = '" & Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", "") & "' and dep_name is not null order by dep_name"

    Debug.Print sQry

    n = getRecordSet(sQry)

    Range(Cells(1, 43), Cells(1 + UBound(n, 1), 43 + UBound(n, 2))) = n
    ActiveWorkbook.Names.Add Name:="dep_list", RefersTo:="=form!" & Range(Cells(1, 44), Cells(1 + UBound(n, 1), 44)).Address
    Range(Cells(1, 43), Cells(1 + UBound(n, 1), 43 + UBound(n, 2))).Font.Color = RGB(255, 255, 255)

    Range(Cells(1, 1).Offset(1, 2).Address).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=dep_list"
    Cells(1, 1).Offset(1, 2).Value = Cells(1, 44)
    Cells(1, 1).Offset(1, 2).Interior.Color = RGB(255, 242, 204)
    Cells(1, 1).Offset(1, 2).Font.Bold = True
    Cells(1, 1).Offset(1, 2).Borders.LineStyle = xlContinuous
    Cells(1, 1).Offset(1, 2).Locked = False

    ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:=Cells(1, 43).Value
    ActiveWorkbook.Names.Add Name:="calc_var", RefersTo:=Cells(1, 45).Value

    ActiveWindow.DisplayGridlines = False
    Application.DisplayAlerts = True
    Columns("C:C").EntireColumn.AutoFit
    ActiveSheet.Protect Password:="30616-3"

    'Call showValuesOper

'        cc = Range("channel_type").Column
'
'    For rr = Range("channel_type").Row + 1 To 3
'        If Cells(rr, cc).Value = "test" Then
'            Range(Cells(rr, cc), Cells(rr, cc + 12)).Select
'        End If
'    Next rr
'

End Sub

Sub showValuesOper()
    Dim i As Long
    Dim j As Long
    Dim r As Long
    Dim m As Integer
    Dim c As Long
    Dim sQry As String
    Dim res As Variant
    Dim scenario As Integer

    ActiveSheet.Unprotect Password:="30616-3"

    If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
        scenario = 1
    ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
        scenario = 2
    End If

    'Product
'    sQry = "select dt, [name], value " _
'            & "from work.kh.user_form_oper " _
'            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
'            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
'            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
'            & "and data_type = 'Ìàêðîïðîäóêò' " _
'            & "and actual = 1"

    sQry = "select a.dt, b.channel_type product, a.value " _
            & "from work.kh.user_form_driver_oper a " _
            & "left join work.kh.sprv_channel b on a.name = b.id_channel " _
            & "where 1 = 1 " _
            & "and id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
            & "and data_type = 1 " _
            & "and is_actual = 1 " _
            & "and scenario = " & scenario _
            & " and value <> 0 " _
            & "order by a.dt "


    res = getRecordSet(sQry)

'-------------------------------------------------
    r = Range("product").Row + 1
    c = Range("product").Column
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents

    r = Range("channel_type").Row + 1
    c = Range("channel_type").Column

    Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents

    r = Range("channel_call").Row + 1
    c = Range("channel_call").Column
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents

    r = Range("product_calc").Row + 1
    c = Range("product_calc").Column
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents

    r = Range("channel_type_calc").Row + 1
    c = Range("channel_type_calc").Column
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents

    r = Range("channel_call_calc").Row + 1
    c = Range("channel_call_calc").Column
    Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
'-------------------------------------------------
    If res(0, 0) = -1 Then
        MsgBox ("Äàííûõ íåò!"), vbInformation
        ActiveSheet.Protect Password:="30616-3"
        Exit Sub
    End If


    r = Range("product").Row + 1
    c = Range("product").Column

    For i = r To Cells(r, c).End(xlDown).Row
        For j = 0 To UBound(res)
            m = Month(res(j, 0))
            If Cells(i, c).Value = res(j, 1) Then
                Cells(i, c).Offset(0, m).Value = res(j, 2)
            End If
        Next j
    Next i

    'channel_type
'    sQry = "select dt, [name], value " _
'            & "from work.kh.user_form_oper " _
'            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
'            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
'            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
'            & "and data_type = 'Êàíàë ïðîäàæ' " _
'            & "and actual = 1"

    sQry = "select a.dt, b.channel_type product, a.value " _
            & "from work.kh.user_form_driver_oper a " _
            & "left join work.kh.sprv_channel b on a.name = b.id_channel " _
            & "where 1 = 1 " _
            & "and id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
            & "and data_type = 2 " _
            & "and is_actual = 1 " _
            & "and scenario = " & scenario _
            & " and value <> 0 " _
            & "order by a.dt "


    res = getRecordSet(sQry)

    r = Range("channel_type").Row + 1
    c = Range("channel_type").Column

    For i = r To Cells(r, c).End(xlDown).Row
        For j = 0 To UBound(res)
            m = Month(res(j, 0))
            If Cells(i, c).Value = res(j, 1) Then
                Cells(i, c).Offset(0, m).Value = res(j, 2)
            End If
        Next j
    Next i

    'channel_call
'    sQry = "select dt, [name], value " _
'            & "from work.kh.user_form_oper " _
'            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
'            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
'            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
'            & "and data_type = 'Êàíàë ïðèâëå÷åíèÿ' " _
'            & "and actual = 1"

    sQry = "select a.dt, b.channel_type product, a.value " _
            & "from work.kh.user_form_driver_oper a " _
            & "left join work.kh.sprv_channel b on a.name = b.id_channel " _
            & "where 1 = 1 " _
            & "and id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
            & "and data_type = 3 " _
            & "and is_actual = 1 " _
            & "and scenario = " & scenario _
            & " and value <> 0 " _
            & "order by a.dt "

    res = getRecordSet(sQry)

    r = Range("channel_call").Row + 1
    c = Range("channel_call").Column

    For i = r To Cells(r, c).End(xlDown).Row
        For j = 0 To UBound(res)
            m = Month(res(j, 0))
            If Cells(i, c).Value = res(j, 1) Then
                Cells(i, c).Offset(0, m).Value = res(j, 2)
            End If
        Next j
    Next i
'-------------------------------------------------------------------------
   'Product
'    sQry = "select dt, [Ìàêðîïðîäóêò], Sum(value) value " _
'            & "from work.kh.user_form_oper_calc_test " _
'            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
'            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
'            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
'            & "and actual = 1" _
'            & "group by dt, Ìàêðîïðîäóêò"

    sQry = "select a.dt, b.channel_type [m_prod], Sum(value) value " _
            & "from work.kh.driver_oper_calc a " _
            & "left join work.kh.sprv_channel b on a.m_prod = b.id_channel " _
            & "where 1 = 1 " _
            & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " " _
            & "and scenario = " & scenario _
            & " and id = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
            & "group by a.dt, b.channel_type " _
            & "order by dt, b.channel_type "

    res = getRecordSet(sQry)

    r = Range("product_calc").Row + 1
    c = Range("product_calc").Column

   If res(0, 0) = -1 Then
        ActiveSheet.Protect Password:="30616-3"
        Exit Sub
    End If

    For i = r To Cells(r, c).End(xlDown).Row
        For j = 0 To UBound(res)
            m = Month(res(j, 0))
            If Cells(i, c).Value = res(j, 1) Then
                Cells(i, c).Offset(0, m).Value = res(j, 2)
            End If
        Next j
    Next i

   'channel_type
'    sQry = "select dt, Case when [Êàíàë ïðîäàæ] in ('Á1','Á1_2') then 'Á' else [Êàíàë ïðîäàæ] end [Êàíàë ïðîäàæ], Sum(value) value " _
'            & "from work.kh.user_form_oper_calc_test " _
'            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
'            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
'            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
'            & "and actual = 1" _
'            & "group by dt, Case when [Êàíàë ïðîäàæ] in ('Á1','Á1_2') then 'Á' else [Êàíàë ïðîäàæ] end"

    sQry = "select a.dt, b.channel_type, Sum(value) value " _
            & "from work.kh.driver_oper_calc a " _
            & "left join work.kh.sprv_channel b on a.channel_type = b.id_channel " _
            & "where 1 = 1 " _
            & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " " _
            & "and scenario = " & scenario _
            & " and id = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
            & "group by a.dt, b.channel_type " _
            & "order by dt, b.channel_type "

    'Debug.Print sQry

    res = getRecordSet(sQry)

    r = Range("channel_type_calc").Row + 1
    c = Range("channel_type_calc").Column

    For i = r To Cells(r, c).End(xlDown).Row
        For j = 0 To UBound(res)
            m = Month(res(j, 0))
            If Cells(i, c).Value = res(j, 1) Then
                Cells(i, c).Offset(0, m).Value = res(j, 2)
            End If
        Next j
    Next i

    'channel_call
'    sQry = "select dt, [Êàíàë ïðèâëå÷åíèÿ], Sum(value) value " _
'            & "from work.kh.user_form_oper_calc_test " _
'            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
'            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
'            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
'            & "and actual = 1" _
'            & "group by dt, [Êàíàë ïðèâëå÷åíèÿ]"

    sQry = "select a.dt, b.channel_type [channel_call], Sum(value) value " _
            & "from work.kh.driver_oper_calc a " _
            & "left join work.kh.sprv_channel b on a.channel_call = b.id_channel " _
            & "where 1 = 1 " _
            & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " " _
            & "and scenario = " & scenario _
            & " and id = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
            & "group by a.dt, b.channel_type " _
            & "order by dt, b.channel_type "

    res = getRecordSet(sQry)

    r = Range("channel_call_calc").Row + 1
    c = Range("channel_call_calc").Column

    For i = r To Cells(r, c).End(xlDown).Row
        For j = 0 To UBound(res)
            m = Month(res(j, 0))
            If Cells(i, c).Value = res(j, 1) Then
                Cells(i, c).Offset(0, m).Value = res(j, 2)
            End If
        Next j
    Next i
    ActiveSheet.Protect Password:="30616-3"
End Sub
Sub CreateEventProcedure_WorkSheetChange_Oper()
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long
    'Dim iid As Long

    'ïîëó÷àåì ññûëêó íà ïðîåêò è ìîäóëü ëèñòà
    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("Ëèñò1")
    Set objCodeMod = objVBComp.CodeModule
    'âñòàâëÿåì êîä
    With objCodeMod
        lLineNum = .CreateEventProc("Change", "Worksheet")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "Dim KeyCells As Range" & Chr(10) _
                                    & "Dim iid As Long" & Chr(10) _
                                    & "Dim s As String" & Chr(10) _
                                    & "Dim i As Integer" & Chr(10) _
                                    & "Set KeyCells = Cells(1, 1).Offset(1, 2)" & Chr(10) _
                                    & "If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then" & Chr(10) _
                                    & "i = 1" & Chr(10) _
                                    & "s = KeyCells.Value" & Chr(10) _
                                    & "Do While Cells(i, 44).Value <> """" " & Chr(10) _
                                    & "If Cells(i, 44).Value = s Then" & Chr(10) _
                                    & "iid = Cells(i, 44).Offset(0, -1).Value" & Chr(10) _
                                    & "ActiveWorkbook.Names.Add Name:=""curr_id"", RefersTo:=  iid " & Chr(10) _
                                    & "ActiveWorkbook.Names.Add Name:=""calc_var"", RefersTo:=Cells(i, 44).Offset(0, 1).value" & Chr(10) _
                                    & "Exit Do" & Chr(10) _
                                    & "End If" & Chr(10) _
                                    & "i = i + 1" & Chr(10) _
                                    & "Loop" & Chr(10) _
                                    & "Call showValuesOper()" & Chr(10) _
                                    & "End If" & Chr(10)
    End With

    Set objVBProj = Nothing
    Set objVBComp = Nothing
    Set objCodeMod = Nothing

End Sub

Sub checkData_1()
Dim r As Long
Dim c As Long
Dim i As Long
Dim j As Long
Dim m As Long
Dim k As Long
Dim max_cnt As Long
Dim res As Double
Dim msg As String
Dim t As String
Dim arr() As Variant
Dim arr1() As Variant
Dim arr2() As Variant
Dim err As Integer
Dim err1 As Integer
Dim sQry As String
Dim dt As String
Dim dt_cumul As String
Dim scenario As Integer


    If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
        scenario = 1
    ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
        scenario = 2
    End If

arr() = Array("product", "channel_type", "channel_call")
arr1() = Array("Ìàêðîïðîäóêò", "Êàíàë ïðîäàæ", "Êàíàë ïðèâëå÷åíèÿ")

m = Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")

For j = 0 To UBound(arr)

    r = Range(arr(j)).Row + 1
    c = Range(arr(j)).Column

    res = Round(Cells(r, c).End(xlDown).Offset(1, i + 1).Value, 9)
    If Round(Cells(r, c).End(xlDown).Offset(1, m + 1).Value, 9) <> 1 Then
        t = "[" & arr1(j) & "]"
        msg = Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "-" & m + 1 & "-" & 1
        MsgBox ("Çíà÷åíèå " & t & " çà: " & Format(msg, "mmm-yyyy") & Chr(10) & "íå çàïîëíåíî!"), vbCritical
        Exit Sub
    Else
        err = m + 1
    End If

    For i = m + 1 To 11
        res = Round(Cells(r, c).End(xlDown).Offset(1, i + 1).Value, 9)
        If res <> 1 And res <> 0 Then
            t = "[" & arr1(j) & "]"
            msg = Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "-" & i + 1 & "-" & 1
            MsgBox ("Çíà÷åíèå " & t & " çà: " & Format(msg, "mmm-yyyy") & Chr(10) & "íå ðàâíî 100%!"), vbCritical
            Exit Sub
        ElseIf res <> 0 Then
            err = i + 1
        End If
    Next i
    If err1 = 0 Then
        err1 = err
    ElseIf err1 > err Then
        err1 = err
    End If
Next j

'delete

'update

arr2() = Array(1, 2, 3)

For j = 0 To UBound(arr2)

    r = Range(arr(j)).Row + 1
    c = Range(arr(j)).Column
    max_cnt = Range(Cells(r, c), Cells(r, c).End(xlDown)).Rows.Count
    For i = m + 1 To err1
        dt = DateAdd("d", -1, DateAdd("m", 1, Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "-" & i & "-01"))

                'delete
               sQry = "delete " _
                        & "from work.kh.user_form_driver_oper " _
                        & "where 1 = 1 " _
                        & "and is_actual = 0 " _
                        & "and id_dep  = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
                        & "and scenario = " & scenario _
                        & " and dt = '" & Format(dt, "yyyy-mm-dd") & "'" _
                        & "and data_type = " & arr2(j)

              '  Debug.Print sQry

                executeSQL (sQry)
                'update
               sQry = "update a " _
                        & "set a.is_actual = 0 " _
                        & "from work.kh.user_form_driver_oper a " _
                        & "where 1 = 1 " _
                        & "and is_actual = 1 " _
                        & "and id_dep  = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
                        & "and scenario = " & scenario _
                        & " and dt = '" & Format(dt, "yyyy-mm-dd") & "'" _
                        & "and data_type = " & arr2(j)
              ' Debug.Print sQry
               executeSQL (sQry)

        For k = r To max_cnt + r - 1
            If Cells(k, c).Offset(0, i) <> "" Or Cells(k, c).Offset(0, i) <> 0 Then
                'insert
               sQry = "insert into work.kh.user_form_driver_oper values('" & Format(dt, "yyyy-mm-dd") & "',getdate()," & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "," _
               & "'" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "'," & arr2(j) & "," & Cells(k, c).Offset(0, -1).Value & "," & Replace(Cells(k, c).Offset(0, i), ",", ".") & "," _
               & scenario & "," _
               & Replace(Replace(ActiveWorkbook.Names("calc_var").Value, "=", ""), """", "") & ",1,null)"
              ' Debug.Print sQry
               executeSQL (sQry)
            End If
        Next k
    Next i
Next j


    sQry = "[kh].[oper_driver_calc_act] ('" & Format(dt, "yyyy-mm-dd") & "'," & scenario & "," & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & ")"
    Debug.Print sQry
    executeSQL sQry '[kh].[oper_driver_calc_act] (@dt date, @scenario int, @id int)


    Call showValuesOper

    MsgBox ("Äàííûå çàãðóæåíû! " & Chr(10) & dt), vbInformation

End Sub


' module: Ëèñò2

Attribute VB_Name = "Ëèñò2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


' module: Ëèñò3

Attribute VB_Name = "Ëèñò3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


' module: Ëèñò4

Attribute VB_Name = "Ëèñò4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True


' module: UserForm1

Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{85807E86-3486-4A50-AC19-CE7811D3A11D}{D9BA6A35-FA3D-4E95-8596-4C26B6A782D0}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub CommandButton1_Click()
ActiveWorkbook.Names.Add Name:="form_type", RefersTo:=UserForm1.ListBox1.Text
UserForm1.Hide
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide

End Sub

Private Sub UserForm_Initialize()
    UserForm1.ListBox1.AddItem ("Îïåðàöèîííûå")
    UserForm1.ListBox1.AddItem ("Ôóíêöèîíàëüíûå")
End Sub


' module: Ëèñò1

Attribute VB_Name = "Ëèñò1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
Private Sub CommandButton1_Click()
ActiveWorkbook.Names.Add Name:="attemp", RefersTo:="1"
Call checkData_1


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim iid As Long
Dim s As String
Dim i As Integer
Set KeyCells = Cells(1, 1).Offset(1, 2)
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
i = 1
s = KeyCells.Value
Do While Cells(i, 44).Value <> ""
If Cells(i, 44).Value = s Then
iid = Cells(i, 44).Offset(0, -1).Value
ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:=iid
ActiveWorkbook.Names.Add Name:="calc_var", RefersTo:=Cells(i, 44).Offset(0, 1).Value
Exit Do
End If
i = i + 1
Loop
Call showValuesOper
End If


End Sub