VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} LIST_FORMULA 
   Caption         =   "Ввод/Редактирование формул контроля"
   ClientHeight    =   3600
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8535
   OleObjectBlob   =   "LIST_FORMULA.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "LIST_FORMULA"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
' pnTypeOnly тип формул для отображения (0 - все)

Public pnMode As Integer, _
        modifyBaseCode As Boolean, grafControl As Boolean, _
        pcCodeStr, pnLinkStr, pnNumGraf, pnTypeOnly As Integer, _
        baseCode___ 'код текущей строки
        
        
' Вызов формы ввода новой формулы
Public Sub New_Formula()
Dim lnTypeForm As Integer, lcInsKey As String
Dim lnColumn As Integer, lnColumnCount As Integer, lnRow As Integer
Dim lSheetsService As Object

On Error GoTo doError

Set lSheetsService = Sheets("Service")

' Вызов формы типов формул
CHOOSE_TYPE.Show
If pbFormCancel Then
    lnTypeForm = CHOOSE_TYPE.pnType
    Unload CHOOSE_TYPE
    'Загрузка формы на редактирование формул
    Load FORMULAEDIT
    ' Установка переменных формы
    FORMULAEDIT.pnTypeFormula = lnTypeForm
    With lSheetsService
        lnColumn = .Range("KRIT_TYPE_FORMULA").Column
        lnColumnCount = .Range("KRIT_TYPE_FORMULA").Columns.count
        lnRow = .Range("KRIT_TYPE_FORMULA").row
        ' Заполнение критерия
        .Cells(lnRow + 1, lnColumn) = lnTypeForm
        FORMULAEDIT.pcTypeFormula = .Cells(lnRow + 2, lnColumn)
        .Range(.Cells(lnRow + 1, lnColumn), .Cells(lnRow + 1, lnColumn + lnColumnCount - 1)) = ""
    End With
    FORMULAEDIT.pbMode = False
    
'    FORMULAEDIT.pcCodeStr = Me.LstFormula.ListItems(ItemKey).SubItems(1)
'    FORMULAEDIT.pnLinkStr = VBA.val(Me.LstFormula.ListItems(ItemKey).Tag)
'    FORMULAEDIT.pnNumGraf = VBA.val(Me.LstFormula.ListItems(ItemKey).TooltipText)
    
    FORMULAEDIT.Form_init
    If modifyBaseCode = False Then
        FORMULAEDIT.CmdBar.Locked = True
    End If
    FORMULAEDIT.Show
    If pbFormCancel Then  ' Новая формула уже вставлена
        Unload FORMULAEDIT
    End If
    If Me.LstFormula.ListItems.count > 0 Then
        Me.LstFormula.ListItems(1).Selected = True
        Me.TlbFormula.Buttons("B2").Enabled = True
        Me.TlbFormula.Buttons("B3").Enabled = True
        Me.CmdSelect.Enabled = True
    End If
Else
    If Me.LstFormula.ListItems.count > 0 Then
        Me.LstFormula.ListItems(1).Selected = True
        Me.TlbFormula.Buttons("B2").Enabled = True
        Me.TlbFormula.Buttons("B3").Enabled = True
    End If
End If
Me.LstFormula.SetFocus

Exit Sub
doError:
    Call ERROR_EVENT("New_Formula")
End Sub
' Вызов формы редактирования выбранной формулы
Public Sub Edit_Formula(ByVal ItemKey As String)
Dim lnColumn As Integer, lnColumnCount As Integer, lnRow As Integer
Dim lSheetsService As Object

On Error GoTo doError

Set lSheetsService = Sheets("Service")
    'Загрузка формы на редактирование формул
    Load FORMULAEDIT
    ' Установка переменных формы
    FORMULAEDIT.pbMode = True
    FORMULAEDIT.pcCodeStr = Me.LstFormula.ListItems(ItemKey).SubItems(1)
    FORMULAEDIT.pnLinkStr = VBA.Val(Me.LstFormula.ListItems(ItemKey).Tag)
    FORMULAEDIT.pnNumGraf = VBA.Val(Me.LstFormula.ListItems(ItemKey).TooltipText)
    'FORMULAEDIT.pnSaveGraf = VBA.val(Me.LstFormula.ListItems(ItemKey).TooltipText)
    FORMULAEDIT.pcTypeFormula = Me.LstFormula.ListItems(ItemKey).SubItems(2)
    FORMULAEDIT.pnNumFormula = VBA.Val(Me.LstFormula.ListItems(ItemKey).Text)
    With lSheetsService
        lnColumn = .Range("KRIT_TYPE_FORMULA").Column
        lnColumnCount = .Range("KRIT_TYPE_FORMULA").Columns.count
        lnRow = .Range("KRIT_TYPE_FORMULA").row
        ' Заполнение критерия
        .Cells(lnRow + 1, lnColumn + 1) = VBA.Trim(FORMULAEDIT.pcTypeFormula)
        FORMULAEDIT.pnTypeFormula = .Cells(lnRow + 2, lnColumn + 1)
        .Range(.Cells(lnRow + 1, lnColumn), .Cells(lnRow + 1, lnColumn + lnColumnCount - 1)) = ""
    End With
    FORMULAEDIT.Form_init
    If modifyBaseCode Then
       FORMULAEDIT.CmdBar.Locked = True
    Else
       FORMULAEDIT.CmdBar.Locked = False
    End If
    FORMULAEDIT.Show
    If pbFormCancel Then  ' Будем обновлять формулу
        Unload FORMULAEDIT
    End If
    Me.LstFormula.ListItems(ItemKey).Selected = True

Exit Sub
doError:
    Call ERROR_EVENT("Edit_Formula")
End Sub
' Процедура удаления выбранной формулы
Public Sub Del_Formula(ByVal ItemKey As String)
Dim lnLinkBar As Integer, lnNumGraf As Integer, lnNumForm As Integer
Dim lbTrue As Boolean
Dim LookRange As Range
Dim lcRow As String

Dim lnColumn As Integer, lnColumnCount As Integer, lnRow As Integer
Dim lnColumn1 As Integer, lnColumnCount1 As Integer, lnRow1 As Integer
Dim lSheetsAlg As Object, lSheetsForm As Object, lSheetsCond As Object
Dim lnResult As Integer

On Error GoTo doError

Set lSheetsAlg = Sheets("ALG")
Set lSheetsForm = Sheets("Form")
Set lSheetsCond = Sheets("OTBOR_COND")
    
    'Проверим ,а есть ли алгоритм расчета по этой формуле
    lnLinkBar = VBA.Val(Me.LstFormula.ListItems(ItemKey).Tag)
    lnNumGraf = VBA.Val(Me.LstFormula.ListItems(ItemKey).TooltipText)
    lnNumForm = VBA.Val(Me.LstFormula.ListItems(ItemKey).Text)
    With lSheetsCond
        lnColumn1 = .Range("KRIT_STR_COND").Column
        lnColumnCount1 = .Range("KRIT_STR_COND").Columns.count
        lnRow1 = .Range("KRIT_STR_COND").row
    End With
    With lSheetsAlg
        lnColumn = .Range("KRIT_ALG").Column
        lnColumnCount = .Range("KRIT_ALG").Columns.count
        lnRow = .Range("KRIT_ALG").row
        .Cells(lnRow + 1, lnColumn + 2) = lnNumForm
    End With
    'Анализ кол-ва записей
    If (lSheetsAlg.Cells(lnRow + 2, lnColumn + 1) = 0 And lSheetsAlg.Cells(lnRow + 2, lnColumn + 2) = 0) _
                    Or lSheetsAlg.Cells(lnRow + 2, lnColumn + 1) = 1 Then     ' Запись одна или несколько (см. второе условие)
        
        lnResult = MsgBox("Формула участвует в алгоритие расчета!" + Chr(10) + Chr(13) + _
                          "При ее удалении будет удален или переопределен соответствующий алгоритм расчета " + Chr(10) + Chr(13) + _
                          "Удалить формулу?", vbQuestion + vbYesNo, pcNameApp + "Внимание")
        
        If lnResult = 6 Then ' Все-таки удаляем
            ' Сначала удалим алгоритм расчета
            lbTrue = True
            With lSheetsAlg
                lnColumn = .Range("TABLE_ALG").Column
                lnColumnCount = .Range("TABLE_ALG").Columns.count
                While lbTrue
                    Set LookRange = .Columns(lnColumn + 2).Find(lnNumForm, LookIn:=xlFormulas, lookat:=xlWhole)
                    If Not LookRange Is Nothing Then
                        'Удаляем запись из БД TABLE_ALG
                        lnRow = LookRange.row
                        ' Если есть условия отбора , то переопределяем алгоритм рачета на них
                        ' Заполним критерий
                        lSheetsCond.Cells(lnRow1 + 1, lnColumn1 + 1) = lnLinkBar
                        lSheetsCond.Cells(lnRow1 + 1, lnColumn1 + 2) = lnNumGraf ' было lnLinkGraf
                        If lSheetsCond.Cells(lnRow1 + 2, lnColumn1 + 1) = 0 And lSheetsCond.Cells(lnRow1 + 2, lnColumn1 + 2) = 0 Then ' Есть условия
                            'Ставим алгоритм по условию
                            .Cells(lnRow, lnColumn + 2) = ""
                            .Cells(lnRow, lnColumn + 3) = 1
                        Else
                            'Удаляем запись из БД TABLE_ALG
                            .Range(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + lnColumnCount - 1)).Delete Shift:=xlUp
                        End If
                        
                    Else
                        lbTrue = False
                    End If
                Wend
            End With
            GoTo Del_For:
        End If
    Else
Del_For:
        'Записей нет - можно смело удалять
        ' Удаляем саму формулу
        With lSheetsForm
            lnColumn = .Range("KRIT_FORM").Column
            lnColumnCount = .Range("KRIT_FORM").Columns.count
            lnRow = .Range("KRIT_FORM").row
            ' Очистка критерия
            .Range(.Cells(lnRow + 1, lnColumn), .Cells(lnRow + 1, lnColumn + lnColumnCount - 2)) = ""
            'Запись в критерий
            .Cells(lnRow + 1, lnColumn + 2) = lnNumForm
           
            lnRow1 = .Cells(lnRow + 4, lnColumn) ' Символьный номер записи в Excel формулы
            ' Очистка критерия
            .Range(.Cells(lnRow + 1, lnColumn), .Cells(lnRow + 1, lnColumn + lnColumnCount - 2)) = ""
            ' Удаление из TABLE_FORM
            lnColumn = .Range("TABLE_FORM").Column
            lnColumnCount = .Range("TABLE_FORM").Columns.count
            .Range(.Cells(lnRow1, lnColumn), .Cells(lnRow1, lnColumn + lnColumnCount - 1)).Delete Shift:=xlUp
        End With
        ' Удаляем формулу из ListView
        Me.LstFormula.ListItems.Remove (ItemKey)
        If Me.LstFormula.ListItems.count > 0 Then
            Me.LstFormula.ListItems(1).Selected = True
        Else
            Me.TlbFormula.Buttons("B2").Enabled = False
            Me.TlbFormula.Buttons("B3").Enabled = False
            Me.CmdSelect.Enabled = False
        End If
    End If

Exit Sub
doError:
    Call ERROR_EVENT("Del_Formula")
End Sub

Private Sub CmdExit_Click()
    Unload Me
End Sub


Private Sub CmdSelect_Click()
    pbFormCancel = True
    Me.Hide
End Sub

Private Sub LstFormula_BeforeLabelEdit(Cancel As Integer)
    Cancel = True
End Sub

Private Sub LstFormula_DblClick()
    If Me.LstFormula.ListItems.count <> 0 Then
        Edit_Formula (Me.LstFormula.SelectedItem.Key)
    End If
End Sub

Private Sub LstFormula_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = 13 Then
    If Me.LstFormula.ListItems.count <> 0 Then
        Edit_Formula (Me.LstFormula.SelectedItem.Key)
    End If
End If
End Sub

Private Sub LstFormula_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Me.LstFormula.ListItems.count <> 0 Then
        Edit_Formula (Me.LstFormula.SelectedItem.Key)
    End If
End If
End Sub

Private Sub TlbFormula_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
    Case "B1"
        Call New_Formula
    Case "B2"
        Call Edit_Formula(Me.LstFormula.SelectedItem.Key)
    Case "B3"
        Call Del_Formula(Me.LstFormula.SelectedItem.Key)
    Case "B5"
        Unload Me
End Select
End Sub

Private Sub UserForm_Initialize()
    Me.pnMode = 0
    Me.Caption = pcNameApp + Me.Caption
    Me.pnTypeOnly = 0
End Sub

Public Sub Form_init()

Dim LookRange As Range
Dim nCnt As Integer, lnNumForm As Integer, lnLinkStr As Integer, lnRowForm As Integer, lnNumGraf As Long
Dim lcCodeStr As String, lnTypeForm As Integer, lcTypeForm As String
Dim lcTextFormula As String, lbYes As Boolean
Dim lnColumn As Long, lnColumnCount As Long, lnRow As Long
Dim lnColumn1 As Long, lnColumnCount1 As Long, lnRow1 As Long
Dim lnCountAllColumn As Long, lnCountAllRow As Long

Dim lSheetsForm As Object, lSheetsReport As Object, lSheetsService As Object, lnRazdel As Integer

On Error GoTo doError

' начало заполнения листа отчета - с какой записи
pnAddress_Row = Sheets("Service").Range("C5")
' - с какой колонки
pnAddress_Col = Sheets("Service").Range("C6")


' Set ImageList
Me.LstFormula.SmallIcons = Me.ImageList1
' Заполнение ListView
Set lSheetsForm = Sheets("FORM")
Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
Set lSheetsService = Sheets("Service")
' Адрес таблицы
lnColumn = lSheetsForm.Range("TABLE_FORM").Column
lnColumnCount = lSheetsForm.Range("TABLE_FORM").Columns.count
lnRow = lSheetsForm.Range("TABLE_FORM").row
' Адрес критерия
lnColumn1 = lSheetsService.Range("KRIT_TYPE_FORMULA").Column
lnColumnCount1 = lSheetsService.Range("KRIT_TYPE_FORMULA").Columns.count
lnRow1 = lSheetsService.Range("KRIT_TYPE_FORMULA").row

lnCountAllColumn = lSheetsService.Range("A10")
lnCountAllRow = lSheetsService.Range("A9")

Set LookRange = lSheetsForm.Columns(lnColumn).Find("", LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows)
' Посмотрим попадает ли ячейка в виртуальное поле ввода
If ActiveCell.row >= pnAddress_Row And _
        ActiveCell.row <= lnCountAllRow + pnAddress_Row - 1 And _
        ActiveCell.Column >= pnAddress_Col And _
        ActiveCell.Column <= pnAddress_Col + lnCountAllColumn - 1 Then
End If


If Not LookRange Is Nothing Then
    lnRowForm = LookRange.row
    If lnRowForm > 2 Then ' Формулы есть
        For nCnt = 2 To lnRowForm - 1
            lnNumForm = lSheetsForm.Cells(nCnt, lnColumn + 2) ' Номер формулы
            lnLinkStr = lSheetsForm.Cells(nCnt, lnColumn) ' Link строки
            lnNumGraf = lSheetsForm.Cells(nCnt, lnColumn + 1)  ' Номер графы
            lnTypeForm = lSheetsForm.Cells(nCnt, lnColumn + 6) ' Тип формулы
            lnRazdel = lSheetsForm.Cells(nCnt, lnColumn + 7) ' Номер раздела (листа)
            ' порсмотрим Link
            lbYes = IIf(lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E2")) = 0, False, True) Or (lSheetsService.Range("B20") <> lnRazdel)
            If lbYes Then
                If lnLinkStr <> lSheetsReport.Cells(ActiveCell.row, pnAddress_Col - lSheetsService.Range("E2")) _
                    Or (lnLinkStr = -1 And lnNumGraf <> pnAddress_Col - ActiveCell.Column) _
                     Or grafControl Or (lSheetsService.Range("B20") <> lnRazdel) Then
                        If Not (grafControl And (lnLinkStr = -1) And (lSheetsService.Range("B20") = lnRazdel)) Then
                            GoTo NextItem:
                        End If
                End If
            End If
            If (lnNumGraf = 0) Or (lnNumGraf = ActiveCell.Column - pnAddress_Col + 1) Or grafControl Then
                If lnLinkStr > 0 Then
                    Set LookRange = lSheetsReport.Range("LINK").Find(lnLinkStr, LookIn:=xlFormulas, lookat:=xlWhole)
                    lcCodeStr = getCode(LookRange.row) 'lSheetsReport.Cells(LookRange.Row, pnAddress_Col - lSheetsService.Range(lSheetsService.Range("E1"))) 'Код строки
                Else
                    lcCodeStr = "Все строки"
                End If
                
                If (pnTypeOnly = 0) Or (pnTypeOnly = lnTypeForm) Then
                    With Me.LstFormula
                        .ListItems.Add , "_" + VBA.Trim(VBA.str(nCnt - 1)), VBA.Trim(VBA.str(lnNumForm)), 0, 5
                        .ListItems("_" + VBA.Trim(VBA.str(nCnt - 1))).SubItems(1) = lcCodeStr
                        ' Определим тип формулы
                        ' Заполним критерий
                        lSheetsService.Cells(lnRow1 + 1, lnColumn1) = lnTypeForm
                        lcTypeForm = lSheetsService.Cells(lnRow1 + 2, lnColumn1)
                        ' Очистим критерий
                        lSheetsService.Range(lSheetsService.Cells(lnRow1 + 1, lnColumn1), lSheetsService.Cells(lnRow1 + 1, lnColumn1 + lnColumnCount1 - 1)) = ""
                        .ListItems("_" + VBA.Trim(VBA.str(nCnt - 1))).SubItems(2) = lcTypeForm
                        .ListItems("_" + VBA.Trim(VBA.str(nCnt - 1))).TooltipText = VBA.Trim(VBA.str(lnNumGraf))
                        .ListItems("_" + VBA.Trim(VBA.str(nCnt - 1))).Tag = VBA.Trim(VBA.str(lnLinkStr))
                    End With
                End If
            End If
NextItem:
        Next
    End If
End If
' Set Toolbar
With Me.TlbFormula
    .ImageList = Me.ImageList1
    .Buttons("B1").Image = 1
    .Buttons("B2").Image = 2
    .Buttons("B3").Image = 3
    .Buttons("B5").Image = 4
    If Me.LstFormula.ListItems.count = 0 Then
        .Buttons("B2").Enabled = False
        .Buttons("B3").Enabled = False
    End If
End With
If Me.pnMode = 1 Then 'Выбор формулы
    Me.CmdSelect.Visible = True
    Me.CmdSelect.Enabled = (Me.LstFormula.ListItems.count > 0)
    Me.TlbFormula.Buttons("B3").Visible = False
End If
modifyBaseCode = True 'разрешить модификацию раздела

Exit Sub
doError:
    Call ERROR_EVENT("LIST_FORMULA.Form_init")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 1 Or CloseMode = 0 Then
    pbFormCancel = False
End If

End Sub
