SHARE
TWEET

Untitled

a guest Jun 18th, 2019 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' module: ÝòàÊíèãà
  2.  
  3. Attribute VB_Name = "ÝòàÊíèãà"
  4. Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
  5. Attribute VB_GlobalNameSpace = False
  6. Attribute VB_Creatable = False
  7. Attribute VB_PredeclaredId = True
  8. Attribute VB_Exposed = True
  9. Attribute VB_TemplateDerived = False
  10. Attribute VB_Customizable = True
  11. Private Sub Workbook_Open()
  12.  
  13.     Application.ActiveWorkbook.Unprotect Password:="30616-3"
  14.     Application.DisplayAlerts = False
  15.     ActiveWorkbook.Worksheets("form").Delete
  16.     ActiveWorkbook.Worksheets.Add
  17.     ActiveWorkbook.Worksheets("Ëèñò1").Name = "form"
  18.    
  19.     If ActiveWorkbook.Worksheets("WARNING").Visible = True Then
  20.         ActiveWorkbook.Worksheets("WARNING").Visible = False
  21.     End If
  22.    
  23.     Application.DisplayAlerts = True
  24.    
  25.     'ThisWorkbook.VBProject.References.AddFromGuid GUID:="{0002E157-0000-0000-C000-000000000046}", Major:=5, Minor:=3
  26.  
  27.     Call Change_warnings
  28.    
  29. End Sub
  30. Sub Change_warnings()
  31.     Dim objExcelApp As Object, objShell As Object, sExVersion As String, lLevel As Long
  32.  
  33.     Set objExcelApp = CreateObject("Excel.Application")
  34.     sExVersion = objExcelApp.Version: objExcelApp.Quit
  35.  
  36.     Set objShell = CreateObject("WScript.Shell")
  37.     lLevel = objShell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Office\" & sExVersion & "\Excel\Security\VBAWarnings", 1, "REG_DWORD")
  38.    
  39.     Set objExcelApp = Nothing: Set objShell = Nothing
  40.     Call Check_VBOM
  41. End Sub
  42. Sub Check_VBOM()
  43.     Dim oVBProj As Object
  44.     On Error Resume Next
  45.     Set oVBProj = ActiveWorkbook.VBProject
  46.     If Not oVBProj Is Nothing Then
  47.         Call setDefaultParams
  48.         Call mainProc 'main_proc
  49.     Else
  50.         MsgBox "Äîñòóï ê îáúåêòíîé ìîäåëè ïðîåêòîâ VBA çàïðåùåí", vbInformation
  51.         ActiveWorkbook.Worksheets("WARNING").Visible = True
  52.         ActiveWorkbook.Worksheets("WARNING").Activate
  53.         ActiveWorkbook.Worksheets("form").Visible = False
  54.     End If
  55. End Sub
  56.  
  57.  
  58.  
  59. ' module: main
  60.  
  61. Attribute VB_Name = "main"
  62. Option Explicit
  63. Sub mainProc()
  64.     'Call setDefaultParams
  65.     If prepareTest Then
  66.         Exit Sub
  67.     Else
  68.         Select Case Replace(Replace(ActiveWorkbook.Names("form_type"), "=", ""), """", "")
  69.             Case "Ôóíêöèîíàëüíûå"
  70.                
  71.                 'ActiveWorkbook.Worksheets("_HELP_").Visible = False
  72.  
  73.                 If ActiveWorkbook.Worksheets("_HELP_").Visible = True Then
  74.                     ActiveWorkbook.Worksheets("_HELP_").Visible = False
  75.                 End If
  76.  
  77.                 If ActiveWorkbook.Worksheets("HELP_").Visible = False Then
  78.                     ActiveWorkbook.Worksheets("HELP_").Visible = True
  79.                 End If
  80.  
  81.                 Call constructFuncForm
  82.                 Call showValues(Replace(Replace(ActiveWorkbook.Names("curr_id"), "=", ""), """", ""))
  83.                 Call applicationEventsDisable
  84.                 Call CreateEventProcedure_WorkSheetChange
  85.                 Call insertButtons
  86.                 Call CreateEventProcedure_CommandButtonOnClick
  87.                 Call applicationEventsEnable
  88.             Case "Îïåðàöèîííûå"
  89.                 ActiveWorkbook.Worksheets("HELP_").Visible = False
  90.  
  91.                 If ActiveWorkbook.Worksheets("_HELP_").Visible = False Then
  92.                     ActiveWorkbook.Worksheets("_HELP_").Visible = True
  93.                 End If
  94.                 Call constructOperForm
  95.                 Call insertButtons
  96.                 Call CreateEventProcedure_CommandButtonOnClick_OPER
  97.                 Call applicationEventsEnable
  98.         End Select
  99.     End If
  100. End Sub
  101. Private Function prepareTest() As Boolean
  102.     Dim u As String
  103.     Dim FormType As String
  104.  
  105.     u = LCase(Environ("username"))
  106.  
  107. ' 1. Ïðîâåðêà âåðñèè ôàéëà
  108.     If checkFormVer() Then
  109.         'MsgBox "Version OK", vbInformation
  110.     Else
  111.         MsgBox "Âåðñèÿ ôàéëà íåàêòóàëüíà.", vbInformation
  112.         prepareTest = True
  113.         Exit Function
  114.     End If
  115.    
  116. ' 2. Ïðîâåðêà ïîëüçîâàòåëÿ
  117.     If checkUser(u) Then
  118.         'MsgBox "User OK", vbInformation
  119.         ActiveWorkbook.Names.Add Name:="user", RefersTo:=u
  120.     Else
  121.         MsgBox "Ïîëüçîâàòåëü íå çàðåãèñòðèðîâàí.", vbInformation
  122.         ActiveWorkbook.Names.Add Name:="user", RefersTo:=u
  123.         prepareTest = True
  124.         Exit Function
  125.     End If
  126.    
  127. ' 3. Ïîëó÷åíèå òèïà ôîðìû
  128.     FormType = getFormType(u)
  129.     If FormType <> "Not defined" Then
  130.         'MsgBox ("FormType - " & FormType), vbInformation
  131.         ActiveWorkbook.Names.Add Name:="form_type", RefersTo:=FormType
  132.     Else
  133.         'MsgBox ("Íå îïðåäåëåí òèï ôîðìû."), vbInformation
  134.         UserForm1.Show
  135.         'ActiveWorkbook.Names.Add Name:="form_type", RefersTo:=FormType
  136.         'prepareTest = True
  137.         'Exit Function
  138.     End If
  139.    
  140. ' 4. Ïðîâåðêà ïëàí/ôàêòà/ïðîãíîçà
  141.     If getPeriodAndType() Then
  142.         'MsgBox ("Ïåðèîä è òèï ÎÊ"), vbInformation
  143.     Else
  144.         prepareTest = True
  145.         MsgBox ("Íå îïðåäåëåí ïåðèîä èëè òèï äàííûõ."), vbInformation
  146.         Exit Function
  147.     End If
  148.    
  149.     Call maxLockMonth(Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", ""))
  150.    
  151.     prepareTest = False
  152. End Function
  153. Private Function checkFormVer() As Integer
  154.     Dim sQry As String
  155.     Dim result As Variant
  156.     Dim form_ver As String
  157.    
  158.     sQry = "select form_ver from work.kh.protect where protect = 0 and is_actual = 1 "
  159.    
  160.     form_ver = Replace(Replace(ActiveWorkbook.Names("ver").Value, "=", ""), """", "")
  161.     result = getRecordSet(sQry)
  162.    
  163.     If result(0, 0) = form_ver Then
  164.         checkFormVer = 1
  165.     Else
  166.         checkFormVer = 0
  167.     End If
  168. End Function
  169. Private Function checkUser(ByRef u As String) As Integer
  170.     Dim sQry As String
  171.     Dim result As Variant
  172.  
  173.     sQry = "select distinct a.user_log from work.kh.user_rules a where 1=1 and a.is_actual = 1 and user_log ='" & u & "'"
  174.    
  175.     result = getRecordSet(sQry)
  176.    
  177.     If LCase(result(0, 0)) = u Then
  178.         checkUser = 1
  179.     Else
  180.         checkUser = 0
  181.     End If
  182. End Function
  183. Private Function getFormType(ByRef u As String) As String
  184.     Dim sQry As String
  185.     Dim result As Variant
  186.  
  187.     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 & "'"
  188.    
  189.     Debug.Print sQry
  190.    
  191.     result = getRecordSet(sQry)
  192.    
  193.     If UBound(result, 1) > 0 Or result(0, 0) = -1 Then
  194.         getFormType = "Not defined"
  195.     Else
  196.         getFormType = result(0, 0)
  197.     End If
  198.    
  199. End Function
  200. Private Function getPeriodAndType() As Variant
  201.     Dim sQry As String
  202.     Dim result As Variant
  203.     Dim i As Long, j As Long
  204.     Dim arr(2) As Variant
  205.    
  206.     sQry = "select [type], [year] from work.kh.control_form where is_actual=1"
  207.     result = getRecordSet(sQry)
  208.    
  209.     For i = LBound(result, 1) To UBound(result, 1)
  210.         For j = LBound(result, 2) To UBound(result, 2)
  211.             If result(i, j) = -1 Then
  212.                 getPeriodAndType = 0
  213.                 Exit Function
  214.             Else
  215.                 arr(j) = result(i, j)
  216.                 getPeriodAndType = 1
  217.             End If
  218.         Next j
  219.     Next i
  220.    
  221.     ActiveWorkbook.Names.Add Name:="paf", RefersTo:=arr(0)
  222.     ActiveWorkbook.Names.Add Name:="year", RefersTo:=arr(1)
  223.    
  224. End Function
  225. Sub setDefaultParams()
  226.     ActiveWorkbook.Names.Add Name:="paf", RefersTo:="0"
  227.     ActiveWorkbook.Names.Add Name:="attemp", RefersTo:="0"
  228.     ActiveWorkbook.Names.Add Name:="user", RefersTo:="0"
  229.     ActiveWorkbook.Names.Add Name:="year", RefersTo:="0"
  230.     ActiveWorkbook.Names.Add Name:="form_type", RefersTo:="0"
  231.     ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:="0"
  232.     ActiveWorkbook.Names.Add Name:="lock_month", RefersTo:="0"
  233.     ActiveWorkbook.Names.Add Name:="calc_var", RefersTo:="0"
  234. End Sub
  235. Private Function getRecordSet(ByRef sQry As String) As Variant
  236.     Dim cn As ADODB.Connection
  237.     Dim sCon As String
  238.     Dim r_set As ADODB.Recordset
  239.     Dim result As Variant
  240.    
  241.     Set cn = New ADODB.Connection
  242.     Set r_set = New ADODB.Recordset
  243.    
  244. 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"
  245. '    sCon = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=SafinIKo;Password=111111;Data Source=DC1-FINDB01\FIN;ConnectionTimeout = 0; Commandtimeout = 0"
  246. '    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"
  247.    
  248.     cn.Open sCon
  249.     Set r_set = cn.Execute(sQry)
  250.    
  251.     If Not r_set.BOF Then
  252.         result = r_set.GetRows
  253.         result = rebuildArray(result)
  254.     Else
  255.         ReDim result(0, 0)
  256.         result(0, 0) = -1
  257.         r_set.Close
  258.         cn.Close
  259.         Set r_set = Nothing
  260.         Set cn = Nothing
  261.         getRecordSet = result
  262.         Exit Function
  263.     End If
  264.    
  265.     r_set.Close
  266.     cn.Close
  267.     Set r_set = Nothing
  268.     Set cn = Nothing
  269.    
  270.     getRecordSet = result
  271.    
  272. End Function
  273.  
  274. Sub constructFuncForm()
  275.     Dim r As Integer, c As Integer, i As Integer, j As Integer, o As Integer
  276.     Dim sTitle As String
  277.     Dim sQry As String
  278.     Dim res As Variant
  279.    
  280.     Application.DisplayAlerts = False
  281.    
  282.     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"
  283.     res = getRecordSet(sQry)
  284.    
  285.    ' Cells(1, 1) = res(1, 1)
  286.     Range(Cells(1, 1), Cells(UBound(res, 1) + 1, UBound(res, 2) + 1)).Value = res
  287.  
  288. '    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"
  289. '    res = getRecordSet(sQry)
  290.  
  291.     ActiveSheet.UsedRange.Columns.AutoFit
  292.     Rows(Cells(1, 1).Row).Insert Shift:=xlDown
  293.     Rows(Cells(1, 1).Row).Insert Shift:=xlDown
  294.     Rows(Cells(1, 1).Row).Insert Shift:=xlDown
  295.    
  296.     c = Cells(1, 1).End(xlDown).End(xlToRight).Offset(-1, 2).Column
  297.     r = Cells(1, 1).End(xlDown).End(xlToRight).Offset(-1, 2).Row
  298.    
  299.     o = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown)).Rows.Count + 1
  300.    
  301.     sTitle = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
  302.    
  303.     Select Case sTitle
  304.         Case "actual"
  305.             sTitle = "ÔÀÊÒ"
  306.         Case "plan"
  307.             sTitle = "ÏËÀÍ"
  308.         Case "forecast"
  309.             sTitle = "ÏÐÎÃÍÎÇ"
  310.     End Select
  311.    
  312.     For i = 0 To 11
  313.         Cells(r, c).Offset(0, i).Value = i + 1
  314.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  315.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  316.         Cells(r, c).Offset(0, i).Interior.Color = RGB(221, 235, 247)
  317.         Cells(r, c).Offset(0, i).Font.Color = RGB(47, 117, 181)
  318.         Cells(r, c + i).Font.Bold = True
  319.        
  320.         Cells(r, c + i).Offset(-1, 0).Value = sTitle & " " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  321.         Cells(r, c).Offset(-1, i).VerticalAlignment = xlCenter
  322.         Cells(r, c).Offset(-1, i).HorizontalAlignment = xlCenter
  323.         Cells(r, c).Offset(-1, i).Interior.Color = RGB(47, 117, 181)
  324.         Cells(r, c).Offset(-1, i).Font.Color = RGB(221, 235, 247)
  325.         Cells(r, c + i).Offset(-1, 0).Font.Bold = True
  326.        
  327.         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)"
  328.         Range(Cells(r, c).Offset(1, i), Cells(r, c).Offset(o - 1, i)).Style = "Percent"
  329.         Cells(r, c).Offset(o, i).Style = "Percent"
  330.         Cells(r, c).Offset(o, i).Font.Bold = True
  331.        
  332.         Cells(r, c).Offset(o, i).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=100%"
  333.         Cells(r, c).Offset(o, i).FormatConditions(Cells(r, c).Offset(o, i).FormatConditions.Count).SetFirstPriority
  334.         With Cells(r, c).Offset(o, i).FormatConditions(1).Font
  335.             .Bold = True
  336.             .Italic = False
  337.             .Color = RGB(255, 255, 255)
  338.             .TintAndShade = 0
  339.         End With
  340.         With Cells(r, c).Offset(o, i).FormatConditions(1).Interior
  341.             .PatternColorIndex = xlAutomatic
  342.             .Color = RGB(255, 0, 0)
  343.             .TintAndShade = 0
  344.         End With
  345.         Cells(r, c).Offset(o, i).FormatConditions(1).StopIfTrue = False
  346.  
  347.         Cells(r, c).Offset(o, i).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0%"
  348.         Cells(r, c).Offset(o, i).FormatConditions(Cells(r, c).Offset(o, i).FormatConditions.Count).SetFirstPriority
  349.         With Cells(r, c).Offset(o, i).FormatConditions(1).Font
  350.             .Bold = True
  351.             .Italic = False
  352.             .Color = RGB(0, 0, 0)
  353.             .TintAndShade = 0
  354.         End With
  355.         With Cells(r, c).Offset(o, i).FormatConditions(1).Interior
  356.             .PatternColorIndex = xlAutomatic
  357.             .Color = RGB(255, 217, 102)
  358.             .TintAndShade = 0
  359.         End With
  360.         Cells(r, c).Offset(o, i).FormatConditions(1).StopIfTrue = False
  361.  
  362.        
  363.     Next i
  364.    
  365.     Range(Cells(r, c + i).Offset(-1, -1), Cells(r, c + i).Offset(-1, -1).End(xlToLeft)).Merge
  366.    
  367.     Columns(Cells(1, 1).Column).Font.Color = RGB(255, 255, 255)
  368.     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"
  369.     '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"
  370.     Debug.Print sQry
  371.     res = getRecordSet(sQry)
  372.    
  373.     Range(Cells(1, 29), Cells(UBound(res, 1) + 1, 31)).Font.Color = RGB(255, 255, 255)
  374.     Range(Cells(1, 29), Cells(UBound(res, 1) + 1, 31)) = res
  375.     ActiveWorkbook.Names.Add Name:="dep_list", RefersTo:="=form!" & Range(Cells(1, 30), Cells(UBound(res, 1) + 1, 30)).Address
  376.     ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:=Cells(1, 29).Value
  377.    
  378.     Range(Cells(1, 1).End(xlDown).Offset(-2, 1).Address).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=dep_list"
  379.     Cells(1, 1).End(xlDown).Offset(-2, 1) = Cells(1, 30)
  380.    
  381.     Cells(1, 1).End(xlDown).Offset(-2, 1).Interior.Color = RGB(255, 242, 204)
  382.     Cells(1, 1).End(xlDown).Offset(-2, 1).Font.Bold = True
  383.     Cells(1, 1).End(xlDown).Offset(-2, 1).Borders.LineStyle = xlContinuous
  384.    
  385.     ActiveWindow.DisplayGridlines = False
  386.    
  387.     Rows(Cells(1, 1).Row).RowHeight = 6
  388.     Columns(Cells(1, 1).Column).ColumnWidth = 0.73
  389.  
  390.        
  391.     Application.DisplayAlerts = True
  392.    
  393. End Sub
  394. Private Function rebuildArray(ByVal arr As Variant) As Variant
  395.     Dim i As Long, j As Long
  396.     Dim a As Integer
  397.     Dim res As Variant
  398.    
  399.     ReDim res(0 To UBound(arr, 2), 0 To UBound(arr, 1))
  400.    
  401.     For i = LBound(arr, 1) To UBound(arr, 1)
  402.         For j = LBound(arr, 2) To UBound(arr, 2)
  403.             res(j, i) = arr(i, j)
  404.         Next j
  405.     Next i
  406.     rebuildArray = res
  407. End Function
  408.  
  409. Sub showValues(ByVal i_id As Long)
  410.     Dim sQry As String
  411.     Dim val() As Variant
  412.     Dim val1() As Variant
  413.     Dim mnth() As Variant
  414.     Dim scenario As Integer
  415.     Dim deps() As Variant
  416.     Dim i As Long, j As Long, k As Long, z As Long, n As Long 'Âñïîìîãàòåëüíûå ïåðåìåííûå äëÿ ðàçíûõ öèêëîâ (â îñíîâíîì äëÿ ïåðåáîðà çíà÷åíèé)
  417.  
  418.     ActiveSheet.Unprotect Password:="30616-3"
  419.  
  420.     '-=Î÷èùàåì ôîðìó îò ïðåäûäóùèõ çíà÷åíèé (ïëîõî ñäåëàíî - ïðèñóòñâóþò magic numbers)=-'
  421.     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
  422.     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
  423.  
  424.     If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
  425.         scenario = 1
  426.     ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
  427.         scenario = 2
  428.     End If
  429.    
  430.     sQry = "select dt, id_recipient, value " _
  431.             & "from work.kh.user_form_driver_func a " _
  432.             & "where 1 = 1 " _
  433.             & "and scenario = " & scenario _
  434.             & "and is_actual = 1" _
  435.             & "and id_source = " & i_id _
  436.             & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  437.             & "and value <> 0 " _
  438.             & "order by dt"
  439.  
  440.  
  441.   '  sQry = "select dt, id, [%%] from work.kh.user_form_func " _
  442.   '          & "where 1 = 1 and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' and actual = 1 " _
  443.   '          & "and id_source in (" & i_id & ") and year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " order by dt"
  444.  
  445.     deps = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown))
  446.     val = getRecordSet(sQry)
  447.  
  448.     j = 0
  449.     z = 0
  450.  
  451.     ReDim Preserve mnth(0)
  452.     If val(0, 0) = -1 Then
  453.         Call lockForm
  454.         MsgBox ("Íåò äàííûõ!")
  455.         Exit Sub
  456.     Else
  457.         mnth(0) = Month(val(0, 0))
  458.     End If
  459.  
  460.     '-=Çàïîëíÿåì ìàññèâ óíèêàëüíûìè äàòàìè, ïðèñóòñòâóþùèõ â çàíåñåííûõ ðàíåå äàííûõ=-'
  461.     For i = 0 To UBound(val) - 1
  462.         If val(z, 0) <> val(i + 1, 0) Then
  463.             z = i + 1
  464.             j = j + 1
  465.             ReDim Preserve mnth(j)
  466.             mnth(j) = Month(val(i + 1, 0))
  467.         End If
  468.     Next i
  469.  
  470.     '-=Ñîçäàåì ìàññèâ äëÿ õðàíåíèÿ èòîãîâûõ ðåçóëüòàòîâ=-'
  471.     val1 = deps
  472.  
  473.     '-=Çàïîëíÿåì ìàññèâ çíà÷åíèÿìè=-'
  474.     For k = 0 To UBound(mnth, 1)
  475.         For i = 1 To UBound(deps, 1)
  476.             For j = 0 To UBound(val, 1)
  477.                 If deps(i, 1) = val(j, 1) And mnth(k) = Month(val(j, 0)) Then
  478.                     val1(i, 1) = val(j, 2)
  479.                     Exit For
  480.                 Else
  481.                     val1(i, 1) = ""
  482.                 End If
  483.             Next j
  484.         Next i
  485.  
  486.         '-=Âûâîäèì ðåçóëüòàò íà ëèñò=-'
  487.         For n = 1 To 12
  488.          
  489.             If Cells(1, 1).End(xlDown).Offset(-1, 3 + n).Value = mnth(k) Then
  490.                 'Cells(1, 1).End(xlDown).End(xlDown).Offset(3, 3 + n).Value = mnth(k)
  491.                 Range(Cells(1, 1).End(xlDown).Offset(0, 2), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown)).Offset(0, n + 1) = val1
  492.                 Exit For
  493.             End If
  494.         Next n
  495.     Next k
  496. Call lockForm
  497. End Sub
  498. Sub lockForm()
  499.     Dim i As Integer, j As Integer
  500.     Dim sTitle As String
  501.     Dim qty As Integer
  502.     Dim lockmonth As Integer
  503.    
  504.     lockmonth = Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")
  505.     qty = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown)).Rows.Count
  506.     i = 2
  507.     j = 0
  508.  
  509. ActiveSheet.Unprotect Password:="30616-3"
  510. 'Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Select
  511.  
  512. 'Ïðîñòàâëÿåì ôëàã 1 äëÿ çàêðûòûõ ïåðèîäîâ
  513. Do While Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Value <> ""
  514.     If Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Offset(-1 - qty, 0).Value <= lockmonth Then
  515.         Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(3, i).Value = 1
  516.     End If
  517.     i = i + 1
  518. Loop
  519.  
  520.  i = 2
  521.     Do While Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Value <> ""
  522.         If Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(3, i).Value = 1 Then
  523.             Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
  524.             Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown).Offset(3, i).Font.Color = RGB(255, 255, 255)
  525.             j = i + 1
  526.         End If
  527.         i = i + 1
  528.     Loop
  529.  
  530.     Cells(1, 1).End(xlDown).Offset(-2, 1).Locked = False
  531.    
  532.     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
  533.     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)
  534.     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)
  535.  
  536.     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
  537.         .Delete
  538.         .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
  539.         :=xlBetween, Formula1:="0", Formula2:="1"
  540.         .IgnoreBlank = True
  541.         .InCellDropdown = True
  542.         .InputTitle = ""
  543.         .ErrorTitle = ""
  544.         .InputMessage = ""
  545.         .ErrorMessage = ""
  546.         .ShowInput = True
  547.         .ShowError = True
  548.     End With
  549.    
  550.     If lockmonth <> 0 Then
  551.         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)
  552.         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)
  553.         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
  554.         Range(Cells(1, 1).End(xlDown).Offset(0, 2), Cells(1, 1).End(xlDown).Offset(0, 2).End(xlDown)).Offset(0, 1).ClearContents
  555.     End If
  556.    
  557.     Call test
  558.    
  559. End Sub
  560.  
  561. Sub test()
  562.     Dim i_id As Long, start_row As Long, st_row As Long, i_id2 As Long
  563.     Dim i As Long, r_max As Long
  564.     Dim r As Long
  565.    
  566.     i_id = Replace(Replace(ActiveWorkbook.Names("curr_id"), "=", ""), """", "")
  567.    
  568.     start_row = Cells(1, 31).Row
  569.  
  570.     Do While Cells(start_row, 31).Value <> ""
  571.         If Cells(start_row, 31).Offset(0, -2).Value = i_id Then
  572.             st_row = Cells(1, 1).End(xlDown).Row
  573.             i_id2 = Cells(start_row, 31).Value
  574.             Do While Cells(st_row, 1).Value <> ""
  575.                 If Cells(st_row, 1).Value = i_id2 Then
  576.                     Cells(st_row, 1).Offset(0, 3).Value = 1
  577.                     Exit Do
  578.                 End If
  579.                 st_row = st_row + 1
  580.             Loop
  581.             Exit Do
  582.         End If
  583.         start_row = start_row + 1
  584.     Loop
  585.    
  586.     i = 0
  587.    
  588.     r_max = Cells(1, 1).End(xlDown).End(xlDown).Row
  589.    
  590.     Do While i <= r_max
  591.         If Cells(1, 1).End(xlDown).Offset(i, 3) = 1 Then
  592.             Range(Cells(1, 1).End(xlDown).Offset(i, 3).EntireRow.Address).Locked = True
  593.             r = Cells(1, 1).End(xlDown).Offset(i, 3).Row
  594.             Range(Cells(r, 2), Cells(r, 3)).Interior.Color = RGB(255, 204, 204)
  595.             Range(Cells(r, 2), Cells(r, 3)).Font.Color = RGB(255, 0, 0)
  596.            
  597.             Range(Cells(r, 2).Offset(0, 3), Cells(r, 2).Offset(0, 14)).Interior.Color = RGB(231, 230, 230)
  598.             Range(Cells(r, 2).Offset(0, 3), Cells(r, 2).Offset(0, 14)).Font.Color = RGB(255, 0, 0)
  599.            
  600.         Else
  601.             r = Cells(1, 1).End(xlDown).Offset(i, 3).Row
  602.             Range(Cells(r, 2), Cells(r, 3)).Interior.Color = xlNone
  603.             Range(Cells(r, 2), Cells(r, 3)).Font.Color = RGB(0, 0, 0)
  604.         End If
  605.         i = i + 1
  606.     Loop
  607.    
  608.     Range("D:D").ClearContents
  609.     Range("D:D").ColumnWidth = 1.33
  610.     Range("D:D").Font.Color = RGB(255, 255, 255)
  611.        
  612.     ActiveSheet.Protect Password:="30616-3"
  613.    
  614. End Sub
  615.  
  616. Sub CreateEventProcedure_WorkSheetChange()
  617.     Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
  618.     Dim lLineNum As Long
  619.  
  620.     'ïîëó÷àåì ññûëêó íà ïðîåêò è ìîäóëü ëèñòà
  621.     Set objVBProj = ActiveWorkbook.VBProject
  622.     Set objVBComp = objVBProj.VBComponents("Ëèñò1")
  623.     Set objCodeMod = objVBComp.CodeModule
  624.     'âñòàâëÿåì êîä
  625.     With objCodeMod
  626.         lLineNum = .CreateEventProc("Change", "Worksheet")
  627.         lLineNum = lLineNum + 1
  628.         .InsertLines lLineNum, "Dim KeyCells As Range" & Chr(10) _
  629.                                     & "Dim iid As Long" & Chr(10) _
  630.                                     & "Dim s As String" & Chr(10) _
  631.                                     & "Dim i As Integer" & Chr(10) _
  632.                                     & "Set KeyCells = Cells(1, 1).End(xlDown).Offset(-2, 1)" & Chr(10) _
  633.                                     & "If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then" & Chr(10) _
  634.                                     & "i = 1" & Chr(10) _
  635.                                     & "s = KeyCells.Value" & Chr(10) _
  636.                                     & "Do While Cells(i, 30).Value <> """" " & Chr(10) _
  637.                                     & "If Cells(i, 30).Value = s Then" & Chr(10) _
  638.                                     & "iid = Cells(i, 30).Offset(0, -1).Value" & Chr(10) _
  639.                                     & "Exit Do" & Chr(10) _
  640.                                     & "End If" & Chr(10) _
  641.                                     & "i = i + 1" & Chr(10) _
  642.                                     & "Loop" & Chr(10) _
  643.                                     & "ActiveWorkbook.Names.Add Name:=""curr_id"", RefersTo:=iid" & Chr(10) _
  644.                                     & "Call showValues(iid)" & Chr(10) _
  645.                                     & "End If" & Chr(10)
  646.     End With
  647.  
  648.     Set objVBProj = Nothing
  649.     Set objVBComp = Nothing
  650.     Set objCodeMod = Nothing
  651.  
  652. End Sub
  653. Sub insertButtons()
  654.     ActiveSheet.Unprotect Password:="30616-3"
  655.     ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
  656.         , DisplayAsIcon:=False, Left:=950, Top:=5, Width:=80, Height:=24) _
  657.         .Select
  658.     ActiveSheet.OLEObjects("CommandButton1").Object.Caption = "Çàãðóçèòü äàííûå"
  659.     ActiveSheet.Protect Password:="30616-3"
  660.     Application.ActiveWorkbook.Protect Password:="30616-3"
  661. End Sub
  662. Sub CreateEventProcedure_CommandButtonOnClick()
  663.  Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
  664.     Dim lLineNum As Long
  665.  
  666.     Set objVBProj = ActiveWorkbook.VBProject
  667.     Set objVBComp = objVBProj.VBComponents("Ëèñò1")
  668.     Set objCodeMod = objVBComp.CodeModule
  669.  
  670.     With objCodeMod
  671.         lLineNum = .CreateEventProc("Click", "CommandButton1")
  672.         lLineNum = lLineNum + 1
  673.         .InsertLines lLineNum, "ActiveWorkbook.Names.Add Name:=""attemp"", RefersTo:=""1""" & Chr(10) _
  674.          & "Call checkData" & Chr(10)
  675.     End With
  676.  
  677.     ActiveWorkbook.VBProject.VBE.MainWindow.Visible = False
  678.    
  679.     Set objVBProj = Nothing
  680.     Set objVBComp = Nothing
  681.     Set objCodeMod = Nothing
  682. End Sub
  683. Sub CreateEventProcedure_CommandButtonOnClick_OPER()
  684.  Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
  685.     Dim lLineNum As Long
  686.  
  687.     Set objVBProj = ActiveWorkbook.VBProject
  688.     Set objVBComp = objVBProj.VBComponents("Ëèñò1")
  689.     Set objCodeMod = objVBComp.CodeModule
  690.  
  691.     With objCodeMod
  692.         lLineNum = .CreateEventProc("Click", "CommandButton1")
  693.         lLineNum = lLineNum + 1
  694.         .InsertLines lLineNum, "ActiveWorkbook.Names.Add Name:=""attemp"", RefersTo:=""1""" & Chr(10) _
  695.          & "Call checkData_1" & Chr(10)
  696.     End With
  697.  
  698.     ActiveWorkbook.VBProject.VBE.MainWindow.Visible = False
  699.    
  700.     Set objVBProj = Nothing
  701.     Set objVBComp = Nothing
  702.     Set objCodeMod = Nothing
  703. End Sub
  704. Sub applicationEventsEnable()
  705.     Application.ScreenUpdating = True
  706.     Application.DisplayAlerts = True
  707.     Application.EnableEvents = True
  708. End Sub
  709. Sub applicationEventsDisable()
  710.     Application.ScreenUpdating = False
  711.     Application.DisplayAlerts = False
  712.     Application.EnableEvents = False
  713. End Sub
  714. Sub checkData()
  715.     Dim ch0 As Double
  716.     Dim ch1 As Double
  717.     Dim r As Integer, c As Integer, qty As Integer, c1 As Integer, r1 As Integer, i As Integer
  718.     Dim m As String
  719.     Dim dt As Date
  720.     Dim s_dt As String
  721.     Dim i_err As Integer
  722.     Dim check_value As Double
  723.     Dim sQry As String
  724.     Dim scenario As Integer
  725.        
  726.        
  727.      If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
  728.         scenario = 1
  729.      ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
  730.         scenario = 2
  731.      End If
  732.        
  733.     ch0 = 0
  734.     ch1 = 1
  735.        
  736.     qty = Range(Cells(1, 1).End(xlDown), Cells(1, 1).End(xlDown).End(xlDown)).Rows.Count
  737.        
  738.     r = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Row
  739.     c = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Column
  740.  
  741.     Do While Cells(r, c).Value = 1
  742.         c = c + 1
  743.     Loop
  744.    
  745.     If c = 17 Then
  746.         MsgBox ("Äàííûå çàáëîêèðîâàíû äëÿ èçìåíåíèÿ"), vbInformation
  747.         Exit Sub
  748.     End If
  749.    
  750.     c1 = c
  751.     r = Cells(r, c).Offset(-2, 0).Row
  752.     r1 = r
  753.    
  754.    
  755.    
  756.     Do While Cells(r, c).Value <> ""
  757.    check_value = Round(Cells(r, c).Value, 9)
  758.         If check_value > ch0 Then
  759.             m = Cells(r, c).Offset(-qty - 1, 0).Value
  760.             dt = "01." & m & "." & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  761.             dt = DateAdd("d", -1, DateAdd("m", 1, dt))
  762.            
  763.             check_value = Round(Cells(r, c).Value, 9)
  764.            
  765.             If check_value <> ch1 Then
  766.                 s_dt = s_dt & Chr(10) & "    *" & Format(dt, "mmmm yyyy")
  767.                 i_err = 1
  768.             End If
  769.         End If
  770.         c = c + 1
  771.     Loop
  772.    
  773.     If i_err = 1 Then
  774.         MsgBox ("Çíà÷åíèÿ íå ðàâíî 100%" & Chr(10) & "Ïåðèîä:" & s_dt), vbCritical
  775.         Exit Sub
  776.     Else
  777.     check_value = Round(Cells(r1, c1).Value, 9)
  778.         If check_value = ch0 Then
  779.             m = Cells(r1, c1).Offset(-qty - 1, 0)
  780.             dt = "01." & m & "." & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  781.             dt = DateAdd("d", -1, DateAdd("m", 1, dt))
  782.             MsgBox ("Íåò äàííûõ çà:" & Chr(10) & "    *" & Format(dt, "mmmm yyyy")), vbCritical
  783.             Exit Sub
  784.         End If
  785.     End If
  786.    
  787. '---------------------------------------------------------------------------------------------
  788.  
  789.     r = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Row
  790.     c = Cells(1, 1).End(xlDown).End(xlDown).End(xlToRight).Offset(3, 2).Column
  791.  
  792.     Do While Cells(r, c).Value = 1
  793.         c = c + 1
  794.     Loop
  795.    
  796. '    If c = 5 Then
  797. '        c = Month(Date) + 3
  798. '    End If
  799.    
  800.     c1 = c
  801.     r = Cells(r, c).Offset(-2, 0).Row
  802.     r1 = r
  803.    
  804.     Do While Cells(r, c).Value <> ""
  805.         If Round(Cells(r, c).Value, 9) > ch0 Then
  806.             m = Cells(r, c).Offset(-qty - 1, 0).Value
  807.             dt = "01." & m & "." & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  808.             dt = DateAdd("d", -1, DateAdd("m", 1, dt))
  809.            
  810.             check_value = Round(Cells(r, c).Value, 9)
  811.            
  812.             If check_value = ch1 Then
  813.                 s_dt = s_dt & Chr(10) & "    *" & Format(dt, "mmmm yyyy")
  814.                
  815.                 i = Cells(1, 1).End(xlDown).Row
  816.                
  817.         '                sQry = "delete " _
  818.         '                        & "from work.kh.user_form_func " _
  819.         '                        & "where 1 = 1 " _
  820.         '                        & "and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  821.         '                        & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
  822.         '                        & "and actual = 0 " _
  823.         '                        & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' "
  824.  
  825.                         sQry = "delete " _
  826.                                 & "from work.kh.user_form_driver_func " _
  827.                                 & "where 1 = 1 " _
  828.                                 & " and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  829.                                 & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
  830.                                 & " and is_actual = 0 " _
  831.                                 & " and scenario = " & scenario
  832.  
  833.  
  834.                         Debug.Print sQry
  835.                         Call executeSQL(sQry)
  836.                        
  837. '                        sQry = "update a " _
  838. '                                & "set a.actual = 0 " _
  839. '                                & "from work.kh.user_form_func a " _
  840. '                                & "where 1 = 1 " _
  841. '                                & "and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  842. '                                & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
  843. '                                & "and actual = 1 " _
  844. '                                & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' "
  845.                        
  846.                         sQry = "update a " _
  847.                                 & "set a.is_actual = 0 " _
  848.                                 & "from work.kh.user_form_driver_func a " _
  849.                                 & "where 1 = 1 " _
  850.                                     & " and id_source = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  851.                                     & " and dt = '" & Format(dt, "yyyy-mm-dd") & "' " _
  852.                                     & " and is_actual = 1 " _
  853.                                     & " and scenario = " & scenario
  854.                        
  855.                        
  856.                         Debug.Print sQry
  857.                         Call executeSQL(sQry)
  858.                        
  859.                 Do While Cells(i, 1).Value <> ""
  860.                     If Cells(i, 1).Offset(0, c - 1).Value <> "" Then
  861.                                
  862.                         sQry = "insert into work.kh.user_form_driver_func (dt, id_source, id_recipient, value, dt_add, [user_name], scenario, is_actual) values (" _
  863.                                 & "'" & Format(dt, "yyyy-mm-dd") & "'," & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "," & Cells(i, 1).Value & "," _
  864.                                 & Replace(Cells(i, 1).Offset(0, c - 1).Value, ",", ".") & ", getdate(), " _
  865.                                 & "'" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "'," _
  866.                                 & scenario & "," _
  867.                                 & 1 & ")"
  868.                                
  869.                         Debug.Print sQry
  870.                         Call executeSQL(sQry)
  871.                     End If
  872.                     i = i + 1
  873.                 Loop
  874.             End If
  875.         End If
  876.         c = c + 1
  877.     Loop
  878.    
  879.     MsgBox ("Çàãðóæåíû äàííûå çà:" & s_dt), vbInformation
  880.    
  881. End Sub
  882. Sub maxLockMonth(ByVal form_type As String)
  883.     Dim sQry As String
  884.     Dim m As Variant
  885.     Dim s As String
  886.     Dim scenario As Integer
  887.    
  888.    
  889.     If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "forecast" Then
  890.         s = "actual"
  891.     Else
  892.         s = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
  893.     End If
  894.    
  895.    
  896.     If s = "actual" Then
  897.         scenario = 2
  898.     ElseIf s = "plan" Then
  899.         scenario = 1
  900.     End If
  901.    
  902.     If form_type = "Îïåðàöèîííûå" Then
  903.    
  904.     sQry = "select isnull(month(max(dt)),-1) m " _
  905.             & "from work.kh.user_form_driver_oper " _
  906.             & "where 1 = 1 " _
  907.             & "and is_actual = 1 " _
  908.             & "and scenario = " & scenario & " " _
  909.             & "and lock_period is not null " _
  910.             & "and year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  911.    
  912.     Debug.Print sQry
  913.    
  914.     Else
  915.    
  916.     sQry = "select isnull(month(max(dt)),-1) m " _
  917.             & "from work.kh.user_form_driver_func " _
  918.             & "where 1 = 1 " _
  919.             & "and is_actual = 1 " _
  920.             & "and scenario = '" & scenario & "' " _
  921.             & "and lock_period is not null " _
  922.             & "and year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  923.    
  924.     End If
  925.    
  926.     m = getRecordSet(sQry)
  927.    
  928.     If m(0, 0) = -1 Then
  929.         ActiveWorkbook.Names.Add Name:="lock_month", RefersTo:="0"
  930.     Else
  931.         ActiveWorkbook.Names.Add Name:="lock_month", RefersTo:=m(0, 0)
  932.     End If
  933. End Sub
  934.  
  935. Sub executeSQL(ByRef sQry)
  936.     Dim cn As ADODB.Connection
  937.     Dim sCon As String
  938.    
  939.    ' sCon = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=SafinIKo;Password=111111;Data Source=DC1-FINDB01\FIN;ConnectionTimeout = 0; Commandtimeout = 0"
  940.   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"
  941.     Set cn = New ADODB.Connection
  942.    
  943.     cn.Open sCon
  944.     cn.Execute sQry
  945.        
  946. End Sub
  947. Sub constructOperForm()
  948.     Call construct_1
  949.     Call construct_2
  950.     Call CreateEventProcedure_WorkSheetChange_Oper
  951.     Call showValuesOper
  952. End Sub
  953.  
  954. Sub construct_1()
  955.     Dim n As Variant
  956.     Dim sTitle As String
  957.     Dim r As Long
  958.     Dim rr As Long
  959.     Dim cc As Long
  960.     Dim c As Long
  961.     Dim i As Long
  962.     Dim sQry As String
  963.    
  964.     Application.DisplayAlerts = False
  965.     ActiveSheet.Unprotect Password:="30616-3"
  966.        
  967.     'Ðàññòàâëÿåì êîíòðîëüíûå òî÷êè
  968.     ActiveWorkbook.Names.Add Name:="product", RefersTo:="=form!" & Range("C6").Address
  969.     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 " _
  970.             & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  971.             & "and a.[type] = 'product' " _
  972.             & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  973.             & "order by name"
  974.            
  975.            
  976.     n = getRecordSet(sQry)
  977.     r = Range("product").Offset(1, 0).Row
  978.     c = Range("product").Offset(1, 0).Column
  979.     Range(Cells(r, c + 1), Cells(UBound(n, 1) + r, c)).Offset(0, -1) = n
  980.    
  981.     ActiveWorkbook.Names.Add Name:="channel_type", RefersTo:="=form!" & Range("product").Offset(1, 0).End(xlDown).Offset(3, 0).Address
  982.    
  983.     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 " _
  984.             & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  985.             & "and a.[type] = 'channel_type' " _
  986.             & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  987.             & "order by name"
  988.            
  989.     n = getRecordSet(sQry)
  990.     r = Range("channel_type").Offset(1, 0).Row
  991.     c = Range("channel_type").Offset(1, 0).Column
  992.     Range(Cells(r, c + 1), Cells(UBound(n, 1) + r, c)).Offset(0, -1) = n
  993.    
  994.    
  995. '    rr = Range("channel_type").Row
  996. '    cc = Range("channel_type").Column
  997. '
  998. '    'Cells(rr, cc).Select
  999. '
  1000. '    Do While Cells(rr + 1, cc).Value <> ""
  1001. '        If Cells(rr + 1, cc).Value = "Á" Then
  1002. '            Cells(rr + 1, cc).EntireRow.Insert
  1003. '            Cells(rr + 1, cc).Value = "test"
  1004. '            Cells(rr + 1, cc).Font.Color = RGB(255, 255, 255)
  1005. '        Exit Do
  1006. '        End If
  1007. '        rr = rr + 1
  1008. '    Loop
  1009. '
  1010.    
  1011.     ActiveWorkbook.Names.Add Name:="channel_call", RefersTo:="=form!" & Range("channel_type").Offset(1, 0).End(xlDown).Offset(3, 0).Address
  1012.    
  1013.     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 " _
  1014.             & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1015.             & "and a.[type] = 'channel_call' " _
  1016.             & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  1017.             & "order by name"
  1018.            
  1019.     n = getRecordSet(sQry)
  1020.     r = Range("channel_call").Offset(1, 0).Row
  1021.     c = Range("channel_call").Offset(1, 0).Column
  1022.     Range(Cells(r, c + 1), Cells(UBound(n, 1) + r, c)).Offset(0, -1) = n
  1023.     '--------------------------------------------------------
  1024.     sTitle = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
  1025.     Select Case sTitle
  1026.     Case "actual"
  1027.         sTitle = "ÔÀÊÒ"
  1028.     Case "plan"
  1029.         sTitle = "ÏËÀÍ"
  1030.     Case "forecast"
  1031.         sTitle = "ÏÐÎÃÍÎÇ"
  1032.     End Select
  1033.        
  1034.     r = Range("product").Row
  1035.     c = Range("product").Column
  1036.    
  1037.     For i = 1 To 12
  1038.         Cells(r, c).Offset(-2, i).Value = sTitle & " " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  1039.         Cells(r, c).Offset(-2, i).HorizontalAlignment = xlCenter
  1040.         Cells(r, c).Offset(-2, i).VerticalAlignment = xlCenter
  1041.         Cells(r, c).Offset(-2, i).Interior.Color = RGB(68, 114, 196)
  1042.         Cells(r, c).Offset(-2, i).Font.Color = RGB(221, 235, 247)
  1043.         Cells(r, c).Offset(-2, i).Font.Bold = True
  1044.        
  1045.         Cells(r, c).Offset(-1, i).Value = i
  1046.         Cells(r, c).Offset(-1, i).Interior.Color = RGB(221, 235, 247)
  1047.         Cells(r, c).Offset(-1, i).Font.Color = RGB(68, 114, 196)
  1048.         Cells(r, c).Offset(-1, i).HorizontalAlignment = xlCenter
  1049.         Cells(r, c).Offset(-1, i).VerticalAlignment = xlCenter
  1050.        
  1051.        
  1052.         Cells(r, c).Offset(0, i).Value = "Ìàêðîïðîäóêò"
  1053.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  1054.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  1055.         Cells(r, c).Offset(0, i).Font.Bold = True
  1056.         Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
  1057.        
  1058.         Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
  1059.         Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
  1060.         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 & ")"
  1061.        
  1062.         Cells(r, c).Offset(0, i).EntireColumn.ColumnWidth = 6.17
  1063.        
  1064.         If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
  1065.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
  1066.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1067.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
  1068.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1069.         Else
  1070.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(255, 242, 204)
  1071.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(255, 217, 102)
  1072.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1073.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False
  1074.            
  1075.             With Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Validation
  1076.                 .Delete
  1077.                 .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
  1078.                 :=xlBetween, Formula1:="0", Formula2:="1"
  1079.                 .IgnoreBlank = True
  1080.                 .InCellDropdown = True
  1081.                 .InputTitle = ""
  1082.                 .ErrorTitle = ""
  1083.                 .InputMessage = ""
  1084.                 .ErrorMessage = ""
  1085.                 .ShowInput = True
  1086.                 .ShowError = True
  1087.             End With
  1088.            
  1089.             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"
  1090.             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
  1091.             With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Font
  1092.                 .Bold = True
  1093.                 .Italic = False
  1094.                 .ThemeColor = xlThemeColorDark1
  1095.                 .TintAndShade = 0
  1096.             End With
  1097.             With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Interior
  1098.                 .PatternColorIndex = xlAutomatic
  1099.                 .Color = 192
  1100.                 .TintAndShade = 0
  1101.             End With
  1102.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).StopIfTrue = False
  1103.            
  1104.         End If
  1105.            
  1106.     Next i
  1107.    
  1108.     Range(Cells(r, c).Offset(-2, 1), Cells(r, c).Offset(-2, 1).End(xlToRight)).Merge
  1109.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge
  1110.    
  1111.     r = Range("channel_type").Row
  1112.     c = Range("channel_type").Column
  1113.    
  1114.     For i = 1 To 12
  1115.         Cells(r, c).Offset(0, i).Value = "Êàíàë ïðîäàæ"
  1116.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  1117.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  1118.         Cells(r, c).Offset(0, i).Font.Bold = True
  1119.         Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
  1120.         Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
  1121.         Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
  1122.         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 & ")"
  1123.  
  1124.         If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
  1125.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
  1126.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1127.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
  1128.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1129.         Else
  1130.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(255, 242, 204)
  1131.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(255, 217, 102)
  1132.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1133.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False
  1134.            
  1135.             With Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Validation
  1136.                 .Delete
  1137.                 .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
  1138.                 :=xlBetween, Formula1:="0", Formula2:="1"
  1139.                 .IgnoreBlank = True
  1140.                 .InCellDropdown = True
  1141.                 .InputTitle = ""
  1142.                 .ErrorTitle = ""
  1143.                 .InputMessage = ""
  1144.                 .ErrorMessage = ""
  1145.                 .ShowInput = True
  1146.                 .ShowError = True
  1147.             End With
  1148.  
  1149.             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"
  1150.             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
  1151.             With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Font
  1152.                 .Bold = True
  1153.                 .Italic = False
  1154.                 .ThemeColor = xlThemeColorDark1
  1155.                 .TintAndShade = 0
  1156.             End With
  1157.             With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Interior
  1158.                 .PatternColorIndex = xlAutomatic
  1159.                 .Color = 192
  1160.                 .TintAndShade = 0
  1161.             End With
  1162.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).StopIfTrue = False
  1163.            
  1164.         End If
  1165.  
  1166.     Next i
  1167.    
  1168.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge
  1169.    
  1170.     r = Range("channel_call").Row
  1171.     c = Range("channel_call").Column
  1172.    
  1173.     For i = 1 To 12
  1174.         Cells(r, c).Offset(0, i).Value = "Êàíàë ïðèâëå÷åíèÿ"
  1175.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  1176.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  1177.         Cells(r, c).Offset(0, i).Font.Bold = True
  1178.         Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
  1179.         Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
  1180.         Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
  1181.         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 & ")"
  1182.  
  1183.         If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
  1184.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
  1185.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1186.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
  1187.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1188.         Else
  1189.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(255, 242, 204)
  1190.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(255, 217, 102)
  1191.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1192.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False
  1193.            
  1194.             With Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Validation
  1195.                 .Delete
  1196.                 .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
  1197.                 :=xlBetween, Formula1:="0", Formula2:="1"
  1198.                 .IgnoreBlank = True
  1199.                 .InCellDropdown = True
  1200.                 .InputTitle = ""
  1201.                 .ErrorTitle = ""
  1202.                 .InputMessage = ""
  1203.                 .ErrorMessage = ""
  1204.                 .ShowInput = True
  1205.                 .ShowError = True
  1206.             End With
  1207.            
  1208.             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"
  1209.             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
  1210.             With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Font
  1211.                 .Bold = True
  1212.                 .Italic = False
  1213.                 .ThemeColor = xlThemeColorDark1
  1214.                 .TintAndShade = 0
  1215.             End With
  1216.             With Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).Interior
  1217.                 .PatternColorIndex = xlAutomatic
  1218.                 .Color = 192
  1219.                 .TintAndShade = 0
  1220.             End With
  1221.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).FormatConditions(1).StopIfTrue = False
  1222.            
  1223.         End If
  1224.  
  1225.     Next i
  1226.    
  1227.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge
  1228.    
  1229.    
  1230.     Range("A:B").ColumnWidth = 1.83
  1231.     Columns("C:C").EntireColumn.AutoFit
  1232.     Rows("1:3").RowHeight = 12
  1233.    
  1234.     Columns("B:B").Font.Color = RGB(255, 255, 255)
  1235.    
  1236.  
  1237. End Sub
  1238. Sub construct_2()
  1239.      Dim n As Variant
  1240.     Dim sTitle As String
  1241.     Dim r As Long
  1242.     Dim rr As Long
  1243.     Dim cc As Long
  1244.     Dim c As Long
  1245.     Dim i As Long
  1246.     Dim sQry As String
  1247.    
  1248.     Application.DisplayAlerts = False
  1249.       ' Stop
  1250.     'Ðàññòàâëÿåì êîíòðîëüíûå òî÷êè
  1251.     ActiveWorkbook.Names.Add Name:="product_calc", RefersTo:="=form!" & Range("S6").Address
  1252.     sQry = "select name from work.kh.sprv where 1 = 1 and " _
  1253.             & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1254.             & "and [type] = 'product' " _
  1255.             & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  1256.             & "order by name"
  1257.     n = getRecordSet(sQry)
  1258.     r = Range("product_calc").Offset(1, 0).Row
  1259.     c = Range("product_calc").Offset(1, 0).Column
  1260.     Range(Cells(r, c), Cells(UBound(n, 1) + r, c)) = n
  1261.    
  1262.     ActiveWorkbook.Names.Add Name:="channel_type_calc", RefersTo:="=form!" & Range("product_calc").Offset(1, 0).End(xlDown).Offset(3, 0).Address
  1263.        sQry = "select name from work.kh.sprv where 1 = 1 and " _
  1264.             & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1265.             & "and [type] = 'channel_type' " _
  1266.             & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  1267.             & "order by name"
  1268.     n = getRecordSet(sQry)
  1269.     r = Range("channel_type_calc").Offset(1, 0).Row
  1270.     c = Range("channel_type_calc").Offset(1, 0).Column
  1271.     Range(Cells(r, c), Cells(UBound(n, 1) + r, c)) = n
  1272.    
  1273.     rr = Range("channel_type_calc").Row
  1274.     cc = Range("channel_type_calc").Column
  1275.    
  1276.     'Cells(rr, cc).Select
  1277.    
  1278.     Do While Cells(rr + 1, cc).Value <> ""
  1279.         If Cells(rr + 1, cc).Value = "Á" Then
  1280.             Cells(rr + 1, cc).EntireRow.Insert
  1281.             Cells(rr + 1, cc).Value = "Á1"
  1282.             Cells(rr + 2, cc).Value = "Á1_2"
  1283.             'Cells(rr + 1, cc).Font.Color = RGB(255, 255, 255)
  1284.         Exit Do
  1285.         End If
  1286.         rr = rr + 1
  1287.     Loop
  1288.  
  1289.  
  1290.     rr = Range("channel_type").Row
  1291.     cc = Range("channel_type").Column
  1292.    
  1293.     Cells(rr, cc).Select
  1294.    
  1295.     Do While Cells(rr + 1, cc).Value <> ""
  1296.         If Cells(rr + 2, cc).Value = "" Then
  1297.             Cells(rr + 2, cc).Select
  1298.             Cells(rr + 2, cc).Value = "test"
  1299.  
  1300.             Cells(rr + 2, cc).Font.Color = RGB(255, 255, 255)
  1301.             Range(Cells(rr + 2, cc + 1), Cells(rr + 2, cc + 12)).Locked = True
  1302.         Exit Do
  1303.         End If
  1304.         rr = rr + 1
  1305.     Loop
  1306.  
  1307.  
  1308.     ActiveWorkbook.Names.Add Name:="channel_call_calc", RefersTo:="=form!" & Range("channel_type_calc").Offset(1, 0).End(xlDown).Offset(3, 0).Address
  1309.     sQry = "select name from work.kh.sprv where 1 = 1 and " _
  1310.             & "scenario = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1311.             & "and [type] = 'channel_call' " _
  1312.             & "and year =  " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") _
  1313.             & "order by name"
  1314.     n = getRecordSet(sQry)
  1315.     r = Range("channel_call_calc").Offset(1, 0).Row
  1316.     c = Range("channel_call_calc").Offset(1, 0).Column
  1317.     Range(Cells(r, c), Cells(UBound(n, 1) + r, c)) = n
  1318.     '--------------------------------------------------------
  1319.     sTitle = Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "")
  1320.     Select Case sTitle
  1321.     Case "actual"
  1322.         sTitle = "ÔÀÊÒ"
  1323.     Case "plan"
  1324.         sTitle = "ÏËÀÍ"
  1325.     Case "forecast"
  1326.         sTitle = "ÏÐÎÃÍÎÇ"
  1327.     End Select
  1328.    
  1329.    
  1330.     r = Range("product_calc").Row
  1331.     c = Range("product_calc").Column
  1332.    
  1333.     For i = 1 To 12
  1334.         Cells(r, c).Offset(-2, i).Value = sTitle & " " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "")
  1335.         Cells(r, c).Offset(-2, i).HorizontalAlignment = xlCenter
  1336.         Cells(r, c).Offset(-2, i).VerticalAlignment = xlCenter
  1337.         Cells(r, c).Offset(-2, i).Interior.Color = RGB(68, 114, 196)
  1338.         Cells(r, c).Offset(-2, i).Font.Color = RGB(221, 235, 247)
  1339.         Cells(r, c).Offset(-2, i).Font.Bold = True
  1340.        
  1341.         Cells(r, c).Offset(-1, i).Value = i
  1342.         Cells(r, c).Offset(-1, i).Interior.Color = RGB(221, 235, 247)
  1343.         Cells(r, c).Offset(-1, i).Font.Color = RGB(68, 114, 196)
  1344.         Cells(r, c).Offset(-1, i).HorizontalAlignment = xlCenter
  1345.         Cells(r, c).Offset(-1, i).VerticalAlignment = xlCenter
  1346.        
  1347.        
  1348.         Cells(r, c).Offset(0, i).Value = "Ìàêðîïðîäóêò"
  1349.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  1350.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  1351.         Cells(r, c).Offset(0, i).Font.Bold = True
  1352.         Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
  1353.        
  1354.         Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
  1355.         Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
  1356.         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 & ")"
  1357.        
  1358.         Cells(r, c).Offset(0, i).EntireColumn.ColumnWidth = 6.17
  1359.        
  1360.         If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
  1361.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
  1362.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1363.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
  1364.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1365.         Else
  1366.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(237, 237, 237)
  1367.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
  1368.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1369.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1370.            ' Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Locked = False
  1371.         End If
  1372.            
  1373.     Next i
  1374.    
  1375.     Range(Cells(r, c).Offset(-2, 1), Cells(r, c).Offset(-2, 1).End(xlToRight)).Merge
  1376.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge
  1377.    
  1378.     r = Range("channel_type_calc").Row
  1379.     c = Range("channel_type_calc").Column
  1380.    
  1381.     For i = 1 To 12
  1382.         Cells(r, c).Offset(0, i).Value = "Êàíàë ïðîäàæ"
  1383.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  1384.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  1385.         Cells(r, c).Offset(0, i).Font.Bold = True
  1386.         Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
  1387.         Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
  1388.         Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
  1389.         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 & ")"
  1390.  
  1391.         If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
  1392.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
  1393.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1394.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
  1395.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1396.         Else
  1397.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(237, 237, 237)
  1398.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
  1399.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1400.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1401.         End If
  1402.  
  1403.     Next i
  1404.    
  1405.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge
  1406.    
  1407.     r = Range("channel_call_calc").Row
  1408.     c = Range("channel_call_calc").Column
  1409.    
  1410.     For i = 1 To 12
  1411.         Cells(r, c).Offset(0, i).Value = "Êàíàë ïðèâëå÷åíèÿ"
  1412.         Cells(r, c).Offset(0, i).HorizontalAlignment = xlCenter
  1413.         Cells(r, c).Offset(0, i).VerticalAlignment = xlCenter
  1414.         Cells(r, c).Offset(0, i).Font.Bold = True
  1415.         Cells(r, c).Offset(0, i).Font.Color = RGB(192, 0, 0)
  1416.         Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Style = "Percent"
  1417.         Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Style = "Percent"
  1418.         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 & ")"
  1419.  
  1420.         If Cells(r, c).Offset(-(r - 5), i) <= CInt(Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")) Then
  1421.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(217, 217, 217)
  1422.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1423.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(174, 170, 170)
  1424.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1425.         Else
  1426.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Interior.Color = RGB(237, 237, 237)
  1427.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Interior.Color = RGB(208, 206, 206)
  1428.             Range(Cells(r, c).Offset(1, 0), Cells(r, c).Offset(1, 0).End(xlDown)).Offset(0, i).Font.Color = RGB(128, 128, 128)
  1429.             Cells(r, c).Offset(1, 0).End(xlDown).Offset(1, i).Font.Color = RGB(0, 0, 0)
  1430.         End If
  1431.  
  1432.     Next i
  1433.    
  1434.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).Offset(0, 1).End(xlToRight)).Merge
  1435.    
  1436.  
  1437.     Application.DisplayAlerts = True
  1438.    
  1439.    
  1440.     Range("P:R").ColumnWidth = 1.57
  1441.     Columns("S:S").EntireColumn.AutoFit
  1442.    
  1443.     Application.DisplayAlerts = True
  1444.    
  1445.     sQry = "select a.id_dep, c.channel_type as dep_name, b.calc_var " _
  1446.             & "from work.kh.user_rules a " _
  1447.             & "left join work.kh.rep_control b on a.id_dep = b.id_dep " _
  1448.             & "left join work.kh.sprv_channel c on a.id_dep = c.id_channel " _
  1449.             & "where 1 = 1 " _
  1450.             & "and is_actual = 1 " _
  1451.             & "and user_log = '" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "' " _
  1452.             & "and b.[type] = '" & Replace(Replace(ActiveWorkbook.Names("form_type").Value, "=", ""), """", "") & "' " _
  1453.             & "and b.calc_var <> 0"
  1454.    
  1455.     '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"
  1456.    
  1457.     Debug.Print sQry
  1458.    
  1459.     n = getRecordSet(sQry)
  1460.    
  1461.     Range(Cells(1, 43), Cells(1 + UBound(n, 1), 43 + UBound(n, 2))) = n
  1462.     ActiveWorkbook.Names.Add Name:="dep_list", RefersTo:="=form!" & Range(Cells(1, 44), Cells(1 + UBound(n, 1), 44)).Address
  1463.     Range(Cells(1, 43), Cells(1 + UBound(n, 1), 43 + UBound(n, 2))).Font.Color = RGB(255, 255, 255)
  1464.  
  1465.     Range(Cells(1, 1).Offset(1, 2).Address).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=dep_list"
  1466.     Cells(1, 1).Offset(1, 2).Value = Cells(1, 44)
  1467.     Cells(1, 1).Offset(1, 2).Interior.Color = RGB(255, 242, 204)
  1468.     Cells(1, 1).Offset(1, 2).Font.Bold = True
  1469.     Cells(1, 1).Offset(1, 2).Borders.LineStyle = xlContinuous
  1470.     Cells(1, 1).Offset(1, 2).Locked = False
  1471.    
  1472.     ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:=Cells(1, 43).Value
  1473.     ActiveWorkbook.Names.Add Name:="calc_var", RefersTo:=Cells(1, 45).Value
  1474.  
  1475.     ActiveWindow.DisplayGridlines = False
  1476.     Application.DisplayAlerts = True
  1477.     Columns("C:C").EntireColumn.AutoFit
  1478.     ActiveSheet.Protect Password:="30616-3"
  1479.    
  1480.     'Call showValuesOper
  1481.    
  1482. '        cc = Range("channel_type").Column
  1483. '
  1484. '    For rr = Range("channel_type").Row + 1 To 3
  1485. '        If Cells(rr, cc).Value = "test" Then
  1486. '            Range(Cells(rr, cc), Cells(rr, cc + 12)).Select
  1487. '        End If
  1488. '    Next rr
  1489. '
  1490.    
  1491. End Sub
  1492.  
  1493. Sub showValuesOper()
  1494.     Dim i As Long
  1495.     Dim j As Long
  1496.     Dim r As Long
  1497.     Dim m As Integer
  1498.     Dim c As Long
  1499.     Dim sQry As String
  1500.     Dim res As Variant
  1501.     Dim scenario As Integer
  1502.    
  1503.     ActiveSheet.Unprotect Password:="30616-3"
  1504.    
  1505.     If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
  1506.         scenario = 1
  1507.     ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
  1508.         scenario = 2
  1509.     End If
  1510.    
  1511.     'Product
  1512. '    sQry = "select dt, [name], value " _
  1513. '            & "from work.kh.user_form_oper " _
  1514. '            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
  1515. '            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
  1516. '            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1517. '            & "and data_type = 'Ìàêðîïðîäóêò' " _
  1518. '            & "and actual = 1"
  1519.    
  1520.     sQry = "select a.dt, b.channel_type product, a.value " _
  1521.             & "from work.kh.user_form_driver_oper a " _
  1522.             & "left join work.kh.sprv_channel b on a.name = b.id_channel " _
  1523.             & "where 1 = 1 " _
  1524.             & "and id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  1525.             & "and data_type = 1 " _
  1526.             & "and is_actual = 1 " _
  1527.             & "and scenario = " & scenario _
  1528.             & " and value <> 0 " _
  1529.             & "order by a.dt "
  1530.  
  1531.    
  1532.     res = getRecordSet(sQry)
  1533.    
  1534. '-------------------------------------------------
  1535.     r = Range("product").Row + 1
  1536.     c = Range("product").Column
  1537.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
  1538.    
  1539.     r = Range("channel_type").Row + 1
  1540.     c = Range("channel_type").Column
  1541.  
  1542.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
  1543.  
  1544.     r = Range("channel_call").Row + 1
  1545.     c = Range("channel_call").Column
  1546.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
  1547.    
  1548.     r = Range("product_calc").Row + 1
  1549.     c = Range("product_calc").Column
  1550.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
  1551.    
  1552.     r = Range("channel_type_calc").Row + 1
  1553.     c = Range("channel_type_calc").Column
  1554.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
  1555.  
  1556.     r = Range("channel_call_calc").Row + 1
  1557.     c = Range("channel_call_calc").Column
  1558.     Range(Cells(r, c).Offset(0, 1), Cells(r, c).End(xlDown).Offset(1, 1).End(xlToRight).Offset(-1, 0)).ClearContents
  1559. '-------------------------------------------------
  1560.     If res(0, 0) = -1 Then
  1561.         MsgBox ("Äàííûõ íåò!"), vbInformation
  1562.         ActiveSheet.Protect Password:="30616-3"
  1563.         Exit Sub
  1564.     End If
  1565.  
  1566.  
  1567.     r = Range("product").Row + 1
  1568.     c = Range("product").Column
  1569.    
  1570.     For i = r To Cells(r, c).End(xlDown).Row
  1571.         For j = 0 To UBound(res)
  1572.             m = Month(res(j, 0))
  1573.             If Cells(i, c).Value = res(j, 1) Then
  1574.                 Cells(i, c).Offset(0, m).Value = res(j, 2)
  1575.             End If
  1576.         Next j
  1577.     Next i
  1578.    
  1579.     'channel_type
  1580. '    sQry = "select dt, [name], value " _
  1581. '            & "from work.kh.user_form_oper " _
  1582. '            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
  1583. '            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
  1584. '            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1585. '            & "and data_type = 'Êàíàë ïðîäàæ' " _
  1586. '            & "and actual = 1"
  1587.  
  1588.     sQry = "select a.dt, b.channel_type product, a.value " _
  1589.             & "from work.kh.user_form_driver_oper a " _
  1590.             & "left join work.kh.sprv_channel b on a.name = b.id_channel " _
  1591.             & "where 1 = 1 " _
  1592.             & "and id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  1593.             & "and data_type = 2 " _
  1594.             & "and is_actual = 1 " _
  1595.             & "and scenario = " & scenario _
  1596.             & " and value <> 0 " _
  1597.             & "order by a.dt "
  1598.  
  1599.            
  1600.     res = getRecordSet(sQry)
  1601.  
  1602.     r = Range("channel_type").Row + 1
  1603.     c = Range("channel_type").Column
  1604.    
  1605.     For i = r To Cells(r, c).End(xlDown).Row
  1606.         For j = 0 To UBound(res)
  1607.             m = Month(res(j, 0))
  1608.             If Cells(i, c).Value = res(j, 1) Then
  1609.                 Cells(i, c).Offset(0, m).Value = res(j, 2)
  1610.             End If
  1611.         Next j
  1612.     Next i
  1613.    
  1614.     'channel_call
  1615. '    sQry = "select dt, [name], value " _
  1616. '            & "from work.kh.user_form_oper " _
  1617. '            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
  1618. '            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
  1619. '            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1620. '            & "and data_type = 'Êàíàë ïðèâëå÷åíèÿ' " _
  1621. '            & "and actual = 1"
  1622.  
  1623.     sQry = "select a.dt, b.channel_type product, a.value " _
  1624.             & "from work.kh.user_form_driver_oper a " _
  1625.             & "left join work.kh.sprv_channel b on a.name = b.id_channel " _
  1626.             & "where 1 = 1 " _
  1627.             & "and id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") _
  1628.             & "and data_type = 3 " _
  1629.             & "and is_actual = 1 " _
  1630.             & "and scenario = " & scenario _
  1631.             & " and value <> 0 " _
  1632.             & "order by a.dt "
  1633.  
  1634.     res = getRecordSet(sQry)
  1635.  
  1636.     r = Range("channel_call").Row + 1
  1637.     c = Range("channel_call").Column
  1638.  
  1639.     For i = r To Cells(r, c).End(xlDown).Row
  1640.         For j = 0 To UBound(res)
  1641.             m = Month(res(j, 0))
  1642.             If Cells(i, c).Value = res(j, 1) Then
  1643.                 Cells(i, c).Offset(0, m).Value = res(j, 2)
  1644.             End If
  1645.         Next j
  1646.     Next i
  1647. '-------------------------------------------------------------------------
  1648.    'Product
  1649. '    sQry = "select dt, [Ìàêðîïðîäóêò], Sum(value) value " _
  1650. '            & "from work.kh.user_form_oper_calc_test " _
  1651. '            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
  1652. '            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
  1653. '            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1654. '            & "and actual = 1" _
  1655. '            & "group by dt, Ìàêðîïðîäóêò"
  1656.    
  1657.     sQry = "select a.dt, b.channel_type [m_prod], Sum(value) value " _
  1658.             & "from work.kh.driver_oper_calc a " _
  1659.             & "left join work.kh.sprv_channel b on a.m_prod = b.id_channel " _
  1660.             & "where 1 = 1 " _
  1661.             & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " " _
  1662.             & "and scenario = " & scenario _
  1663.             & " and id = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
  1664.             & "group by a.dt, b.channel_type " _
  1665.             & "order by dt, b.channel_type "
  1666.    
  1667.     res = getRecordSet(sQry)
  1668.  
  1669.     r = Range("product_calc").Row + 1
  1670.     c = Range("product_calc").Column
  1671.    
  1672.    If res(0, 0) = -1 Then
  1673.         ActiveSheet.Protect Password:="30616-3"
  1674.         Exit Sub
  1675.     End If
  1676.    
  1677.     For i = r To Cells(r, c).End(xlDown).Row
  1678.         For j = 0 To UBound(res)
  1679.             m = Month(res(j, 0))
  1680.             If Cells(i, c).Value = res(j, 1) Then
  1681.                 Cells(i, c).Offset(0, m).Value = res(j, 2)
  1682.             End If
  1683.         Next j
  1684.     Next i
  1685.  
  1686.    'channel_type
  1687. '    sQry = "select dt, Case when [Êàíàë ïðîäàæ] in ('Á1','Á1_2') then 'Á' else [Êàíàë ïðîäàæ] end [Êàíàë ïðîäàæ], Sum(value) value " _
  1688. '            & "from work.kh.user_form_oper_calc_test " _
  1689. '            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
  1690. '            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
  1691. '            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1692. '            & "and actual = 1" _
  1693. '            & "group by dt, Case when [Êàíàë ïðîäàæ] in ('Á1','Á1_2') then 'Á' else [Êàíàë ïðîäàæ] end"
  1694.            
  1695.     sQry = "select a.dt, b.channel_type, Sum(value) value " _
  1696.             & "from work.kh.driver_oper_calc a " _
  1697.             & "left join work.kh.sprv_channel b on a.channel_type = b.id_channel " _
  1698.             & "where 1 = 1 " _
  1699.             & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " " _
  1700.             & "and scenario = " & scenario _
  1701.             & " and id = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
  1702.             & "group by a.dt, b.channel_type " _
  1703.             & "order by dt, b.channel_type "
  1704.            
  1705.     'Debug.Print sQry
  1706.            
  1707.     res = getRecordSet(sQry)
  1708.  
  1709.     r = Range("channel_type_calc").Row + 1
  1710.     c = Range("channel_type_calc").Column
  1711.    
  1712.     For i = r To Cells(r, c).End(xlDown).Row
  1713.         For j = 0 To UBound(res)
  1714.             m = Month(res(j, 0))
  1715.             If Cells(i, c).Value = res(j, 1) Then
  1716.                 Cells(i, c).Offset(0, m).Value = res(j, 2)
  1717.             End If
  1718.         Next j
  1719.     Next i
  1720.    
  1721.     'channel_call
  1722. '    sQry = "select dt, [Êàíàë ïðèâëå÷åíèÿ], Sum(value) value " _
  1723. '            & "from work.kh.user_form_oper_calc_test " _
  1724. '            & "where id_dep = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "" _
  1725. '            & "and Year(dt) = '" & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "' " _
  1726. '            & "and plan_actual = '" & Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") & "' " _
  1727. '            & "and actual = 1" _
  1728. '            & "group by dt, [Êàíàë ïðèâëå÷åíèÿ]"
  1729.            
  1730.     sQry = "select a.dt, b.channel_type [channel_call], Sum(value) value " _
  1731.             & "from work.kh.driver_oper_calc a " _
  1732.             & "left join work.kh.sprv_channel b on a.channel_call = b.id_channel " _
  1733.             & "where 1 = 1 " _
  1734.             & "and Year(dt) = " & Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & " " _
  1735.             & "and scenario = " & scenario _
  1736.             & " and id = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
  1737.             & "group by a.dt, b.channel_type " _
  1738.             & "order by dt, b.channel_type "
  1739.            
  1740.     res = getRecordSet(sQry)
  1741.  
  1742.     r = Range("channel_call_calc").Row + 1
  1743.     c = Range("channel_call_calc").Column
  1744.    
  1745.     For i = r To Cells(r, c).End(xlDown).Row
  1746.         For j = 0 To UBound(res)
  1747.             m = Month(res(j, 0))
  1748.             If Cells(i, c).Value = res(j, 1) Then
  1749.                 Cells(i, c).Offset(0, m).Value = res(j, 2)
  1750.             End If
  1751.         Next j
  1752.     Next i
  1753.     ActiveSheet.Protect Password:="30616-3"
  1754. End Sub
  1755. Sub CreateEventProcedure_WorkSheetChange_Oper()
  1756.     Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
  1757.     Dim lLineNum As Long
  1758.     'Dim iid As Long
  1759.  
  1760.     'ïîëó÷àåì ññûëêó íà ïðîåêò è ìîäóëü ëèñòà
  1761.     Set objVBProj = ActiveWorkbook.VBProject
  1762.     Set objVBComp = objVBProj.VBComponents("Ëèñò1")
  1763.     Set objCodeMod = objVBComp.CodeModule
  1764.     'âñòàâëÿåì êîä
  1765.     With objCodeMod
  1766.         lLineNum = .CreateEventProc("Change", "Worksheet")
  1767.         lLineNum = lLineNum + 1
  1768.         .InsertLines lLineNum, "Dim KeyCells As Range" & Chr(10) _
  1769.                                     & "Dim iid As Long" & Chr(10) _
  1770.                                     & "Dim s As String" & Chr(10) _
  1771.                                     & "Dim i As Integer" & Chr(10) _
  1772.                                     & "Set KeyCells = Cells(1, 1).Offset(1, 2)" & Chr(10) _
  1773.                                     & "If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then" & Chr(10) _
  1774.                                     & "i = 1" & Chr(10) _
  1775.                                     & "s = KeyCells.Value" & Chr(10) _
  1776.                                     & "Do While Cells(i, 44).Value <> """" " & Chr(10) _
  1777.                                     & "If Cells(i, 44).Value = s Then" & Chr(10) _
  1778.                                     & "iid = Cells(i, 44).Offset(0, -1).Value" & Chr(10) _
  1779.                                     & "ActiveWorkbook.Names.Add Name:=""curr_id"", RefersTo:=  iid " & Chr(10) _
  1780.                                     & "ActiveWorkbook.Names.Add Name:=""calc_var"", RefersTo:=Cells(i, 44).Offset(0, 1).value" & Chr(10) _
  1781.                                     & "Exit Do" & Chr(10) _
  1782.                                     & "End If" & Chr(10) _
  1783.                                     & "i = i + 1" & Chr(10) _
  1784.                                     & "Loop" & Chr(10) _
  1785.                                     & "Call showValuesOper()" & Chr(10) _
  1786.                                     & "End If" & Chr(10)
  1787.     End With
  1788.  
  1789.     Set objVBProj = Nothing
  1790.     Set objVBComp = Nothing
  1791.     Set objCodeMod = Nothing
  1792.  
  1793. End Sub
  1794.  
  1795. Sub checkData_1()
  1796. Dim r As Long
  1797. Dim c As Long
  1798. Dim i As Long
  1799. Dim j As Long
  1800. Dim m As Long
  1801. Dim k As Long
  1802. Dim max_cnt As Long
  1803. Dim res As Double
  1804. Dim msg As String
  1805. Dim t As String
  1806. Dim arr() As Variant
  1807. Dim arr1() As Variant
  1808. Dim arr2() As Variant
  1809. Dim err As Integer
  1810. Dim err1 As Integer
  1811. Dim sQry As String
  1812. Dim dt As String
  1813. Dim dt_cumul As String
  1814. Dim scenario As Integer
  1815.  
  1816.  
  1817.     If Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "plan" Then
  1818.         scenario = 1
  1819.     ElseIf Replace(Replace(ActiveWorkbook.Names("paf").Value, "=", ""), """", "") = "actual" Then
  1820.         scenario = 2
  1821.     End If
  1822.  
  1823. arr() = Array("product", "channel_type", "channel_call")
  1824. arr1() = Array("Ìàêðîïðîäóêò", "Êàíàë ïðîäàæ", "Êàíàë ïðèâëå÷åíèÿ")
  1825.  
  1826. m = Replace(Replace(ActiveWorkbook.Names("lock_month").Value, "=", ""), """", "")
  1827.  
  1828. For j = 0 To UBound(arr)
  1829.  
  1830.     r = Range(arr(j)).Row + 1
  1831.     c = Range(arr(j)).Column
  1832.    
  1833.     res = Round(Cells(r, c).End(xlDown).Offset(1, i + 1).Value, 9)
  1834.     If Round(Cells(r, c).End(xlDown).Offset(1, m + 1).Value, 9) <> 1 Then
  1835.         t = "[" & arr1(j) & "]"
  1836.         msg = Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "-" & m + 1 & "-" & 1
  1837.         MsgBox ("Çíà÷åíèå " & t & " çà: " & Format(msg, "mmm-yyyy") & Chr(10) & "íå çàïîëíåíî!"), vbCritical
  1838.         Exit Sub
  1839.     Else
  1840.         err = m + 1
  1841.     End If
  1842.    
  1843.     For i = m + 1 To 11
  1844.         res = Round(Cells(r, c).End(xlDown).Offset(1, i + 1).Value, 9)
  1845.         If res <> 1 And res <> 0 Then
  1846.             t = "[" & arr1(j) & "]"
  1847.             msg = Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "-" & i + 1 & "-" & 1
  1848.             MsgBox ("Çíà÷åíèå " & t & " çà: " & Format(msg, "mmm-yyyy") & Chr(10) & "íå ðàâíî 100%!"), vbCritical
  1849.             Exit Sub
  1850.         ElseIf res <> 0 Then
  1851.             err = i + 1
  1852.         End If
  1853.     Next i
  1854.     If err1 = 0 Then
  1855.         err1 = err
  1856.     ElseIf err1 > err Then
  1857.         err1 = err
  1858.     End If
  1859. Next j
  1860.  
  1861. 'delete
  1862.  
  1863. 'update
  1864.  
  1865. arr2() = Array(1, 2, 3)
  1866.  
  1867. For j = 0 To UBound(arr2)
  1868.  
  1869.     r = Range(arr(j)).Row + 1
  1870.     c = Range(arr(j)).Column
  1871.     max_cnt = Range(Cells(r, c), Cells(r, c).End(xlDown)).Rows.Count
  1872.     For i = m + 1 To err1
  1873.         dt = DateAdd("d", -1, DateAdd("m", 1, Replace(Replace(ActiveWorkbook.Names("year").Value, "=", ""), """", "") & "-" & i & "-01"))
  1874.        
  1875.                 'delete
  1876.                sQry = "delete " _
  1877.                         & "from work.kh.user_form_driver_oper " _
  1878.                         & "where 1 = 1 " _
  1879.                         & "and is_actual = 0 " _
  1880.                         & "and id_dep  = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
  1881.                         & "and scenario = " & scenario _
  1882.                         & " and dt = '" & Format(dt, "yyyy-mm-dd") & "'" _
  1883.                         & "and data_type = " & arr2(j)
  1884.                        
  1885.               '  Debug.Print sQry
  1886.                
  1887.                 executeSQL (sQry)
  1888.                 'update
  1889.                sQry = "update a " _
  1890.                         & "set a.is_actual = 0 " _
  1891.                         & "from work.kh.user_form_driver_oper a " _
  1892.                         & "where 1 = 1 " _
  1893.                         & "and is_actual = 1 " _
  1894.                         & "and id_dep  = " & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & " " _
  1895.                         & "and scenario = " & scenario _
  1896.                         & " and dt = '" & Format(dt, "yyyy-mm-dd") & "'" _
  1897.                         & "and data_type = " & arr2(j)
  1898.               ' Debug.Print sQry
  1899.                executeSQL (sQry)
  1900.  
  1901.         For k = r To max_cnt + r - 1
  1902.             If Cells(k, c).Offset(0, i) <> "" Or Cells(k, c).Offset(0, i) <> 0 Then
  1903.                 'insert
  1904.                sQry = "insert into work.kh.user_form_driver_oper values('" & Format(dt, "yyyy-mm-dd") & "',getdate()," & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & "," _
  1905.                & "'" & Replace(Replace(ActiveWorkbook.Names("user").Value, "=", ""), """", "") & "'," & arr2(j) & "," & Cells(k, c).Offset(0, -1).Value & "," & Replace(Cells(k, c).Offset(0, i), ",", ".") & "," _
  1906.                & scenario & "," _
  1907.                & Replace(Replace(ActiveWorkbook.Names("calc_var").Value, "=", ""), """", "") & ",1,null)"
  1908.               ' Debug.Print sQry
  1909.                executeSQL (sQry)
  1910.             End If
  1911.         Next k
  1912.     Next i
  1913. Next j
  1914.    
  1915.    
  1916.     sQry = "[kh].[oper_driver_calc_act] ('" & Format(dt, "yyyy-mm-dd") & "'," & scenario & "," & Replace(Replace(ActiveWorkbook.Names("curr_id").Value, "=", ""), """", "") & ")"
  1917.     Debug.Print sQry
  1918.     executeSQL sQry '[kh].[oper_driver_calc_act] (@dt date, @scenario int, @id int)
  1919.    
  1920.    
  1921.     Call showValuesOper
  1922.    
  1923.     MsgBox ("Äàííûå çàãðóæåíû! " & Chr(10) & dt), vbInformation
  1924.    
  1925. End Sub
  1926.  
  1927.  
  1928. ' module: Ëèñò2
  1929.  
  1930. Attribute VB_Name = "Ëèñò2"
  1931. Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
  1932. Attribute VB_GlobalNameSpace = False
  1933. Attribute VB_Creatable = False
  1934. Attribute VB_PredeclaredId = True
  1935. Attribute VB_Exposed = True
  1936. Attribute VB_TemplateDerived = False
  1937. Attribute VB_Customizable = True
  1938.  
  1939.  
  1940. ' module: Ëèñò3
  1941.  
  1942. Attribute VB_Name = "Ëèñò3"
  1943. Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
  1944. Attribute VB_GlobalNameSpace = False
  1945. Attribute VB_Creatable = False
  1946. Attribute VB_PredeclaredId = True
  1947. Attribute VB_Exposed = True
  1948. Attribute VB_TemplateDerived = False
  1949. Attribute VB_Customizable = True
  1950.  
  1951.  
  1952. ' module: Ëèñò4
  1953.  
  1954. Attribute VB_Name = "Ëèñò4"
  1955. Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
  1956. Attribute VB_GlobalNameSpace = False
  1957. Attribute VB_Creatable = False
  1958. Attribute VB_PredeclaredId = True
  1959. Attribute VB_Exposed = True
  1960. Attribute VB_TemplateDerived = False
  1961. Attribute VB_Customizable = True
  1962.  
  1963.  
  1964. ' module: UserForm1
  1965.  
  1966. Attribute VB_Name = "UserForm1"
  1967. Attribute VB_Base = "0{85807E86-3486-4A50-AC19-CE7811D3A11D}{D9BA6A35-FA3D-4E95-8596-4C26B6A782D0}"
  1968. Attribute VB_GlobalNameSpace = False
  1969. Attribute VB_Creatable = False
  1970. Attribute VB_PredeclaredId = True
  1971. Attribute VB_Exposed = False
  1972. Attribute VB_TemplateDerived = False
  1973. Attribute VB_Customizable = False
  1974.  
  1975. Private Sub CommandButton1_Click()
  1976. ActiveWorkbook.Names.Add Name:="form_type", RefersTo:=UserForm1.ListBox1.Text
  1977. UserForm1.Hide
  1978. End Sub
  1979.  
  1980. Private Sub CommandButton2_Click()
  1981. UserForm1.Hide
  1982.  
  1983. End Sub
  1984.  
  1985. Private Sub UserForm_Initialize()
  1986.     UserForm1.ListBox1.AddItem ("Îïåðàöèîííûå")
  1987.     UserForm1.ListBox1.AddItem ("Ôóíêöèîíàëüíûå")
  1988. End Sub
  1989.  
  1990.  
  1991. ' module: Ëèñò1
  1992.  
  1993. Attribute VB_Name = "Ëèñò1"
  1994. Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
  1995. Attribute VB_GlobalNameSpace = False
  1996. Attribute VB_Creatable = False
  1997. Attribute VB_PredeclaredId = True
  1998. Attribute VB_Exposed = True
  1999. Attribute VB_TemplateDerived = False
  2000. Attribute VB_Customizable = True
  2001. Attribute VB_Control = "CommandButton1, 1, 0, MSForms, CommandButton"
  2002. Private Sub CommandButton1_Click()
  2003. ActiveWorkbook.Names.Add Name:="attemp", RefersTo:="1"
  2004. Call checkData_1
  2005.  
  2006.  
  2007. End Sub
  2008.  
  2009. Private Sub Worksheet_Change(ByVal Target As Range)
  2010. Dim KeyCells As Range
  2011. Dim iid As Long
  2012. Dim s As String
  2013. Dim i As Integer
  2014. Set KeyCells = Cells(1, 1).Offset(1, 2)
  2015. If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
  2016. i = 1
  2017. s = KeyCells.Value
  2018. Do While Cells(i, 44).Value <> ""
  2019. If Cells(i, 44).Value = s Then
  2020. iid = Cells(i, 44).Offset(0, -1).Value
  2021. ActiveWorkbook.Names.Add Name:="curr_id", RefersTo:=iid
  2022. ActiveWorkbook.Names.Add Name:="calc_var", RefersTo:=Cells(i, 44).Offset(0, 1).Value
  2023. Exit Do
  2024. End If
  2025. i = i + 1
  2026. Loop
  2027. Call showValuesOper
  2028. End If
  2029.  
  2030.  
  2031. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top