VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} DetailParam 
   Caption         =   "Параметры расшифровки"
   ClientHeight    =   5250
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4725
   OleObjectBlob   =   "DetailParam.frx":0000
   StartUpPosition =   1  'ПоЦентруВладельца
End
Attribute VB_Name = "DetailParam"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False








Option Explicit
Dim linkCode, linkRow

' Процедура Move Items в ListView
Public Sub Move_Item(Direct As Integer)
Dim lcText As String, lcSubitem1 As String, lcSubitem2 As String
Dim lnIndex As Long, check As Boolean

On Error GoTo doError

If Me.ListView1.ListItems.count > 0 Then
    With Me.ListView1
        lcText = .SelectedItem.Text
        lcSubitem1 = .SelectedItem.SubItems(1)
        'lcSubitem2 = .SelectedItem.SubItems(2)
        check = .SelectedItem.Checked
        If Direct = 1 Then
            If .SelectedItem.index = 1 Then Exit Sub 'Me.CmdTest.Enabled = True:
            lnIndex = .SelectedItem.index - 1
        Else
            If .SelectedItem.index = .ListItems.count Then Exit Sub 'Me.CmdTest.Enabled = True:
            lnIndex = .SelectedItem.index + 1
        End If
        .SelectedItem.Text = .ListItems(lnIndex).Text
        .SelectedItem.SubItems(1) = .ListItems(lnIndex).SubItems(1)
        '.SelectedItem.SubItems(2) = .ListItems(lnIndex).SubItems(2)
        .SelectedItem.Checked = .ListItems(lnIndex).Checked
        
        .ListItems(lnIndex).Text = lcText
        .ListItems(lnIndex).SubItems(1) = lcSubitem1
        '.ListItems(lnIndex).SubItems(2) = lcSubitem2
        .ListItems(lnIndex).Checked = check
        .ListItems(lnIndex).Selected = True
        .ListItems(lnIndex).EnsureVisible
        'Me.CmdTest.Enabled = True
        'Call Me.ListView1_KeyDown(10, 0)
        .SetFocus
        '.Refresh
    End With
End If
'Me.CmdSAVE.Enabled = True

Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.Move_Item")
End Sub

Private Sub CommandButton10_Click()
Dim i, lSheetsDetail As Object, sheetsService As Object, j, sum, str
Dim DETAIL_ROW, DETAIL_COLUMN, DETAIL_COLUMNCOUNT, table_spr_column, table_spr_row
Dim min As Integer, id As Integer, flag As Boolean
On Error GoTo doError

    Set lSheetsDetail = Sheets("Расшифровка")
    
    Set sheetsService = Sheets("Service")
    table_spr_row = sheetsService.Range("TABLE_SPR").row
    table_spr_column = sheetsService.Range("TABLE_SPR").Column
    
    summaCol = 0
    codeCol = 0
    DETAIL_ROW = lSheetsDetail.Range("DETAIL_HEAD").row
    DETAIL_COLUMN = lSheetsDetail.Range("DETAIL_HEAD").Column
    DETAIL_COLUMNCOUNT = lSheetsDetail.Range("DETAIL_HEAD").Columns.count
    Sheets("Расшифровка").Rows(VBA.Trim(VBA.str(DETAIL_ROW)) + ":" + VBA.Trim(VBA.str(DETAIL_ROW + 1))).Clear
    
    For i = 1 To Me.ListView1.ListItems.count
        If Me.ListView1.ListItems(i).Checked Then
            lSheetsDetail.Cells(DETAIL_ROW + 1, DETAIL_COLUMN) = Me.ListView1.ListItems(i).SubItems(1)
            
            lSheetsDetail.Cells(DETAIL_ROW, DETAIL_COLUMN) = Me.ListView1.ListItems(i)
            If Me.ListView1.ListItems(i).SubItems(1) = "CODE" Then codeCol = DETAIL_COLUMN
            If Me.ListView1.ListItems(i).SubItems(1) = "SUMMA" Then summaCol = DETAIL_COLUMN
            If Me.ListView1.ListItems(i).SubItems(1) = "BZSUMM" Then summaPlusCol = DETAIL_COLUMN
            DETAIL_COLUMN = DETAIL_COLUMN + 1
        End If
    Next
    columnDetailCount = DETAIL_COLUMN - 1
    If columnDetailCount - lSheetsDetail.Range("DETAIL_HEAD").Column < 1 Then
        Call MsgBox("Нельзя создать отчет, содержащий менее двух граф !", vbOKOnly + vbExclamation, "Внимание !")
        Exit Sub
    End If
    
    'форматируем заголовок
    With lSheetsDetail.Range(lSheetsDetail.Cells(DETAIL_ROW, lSheetsDetail.Range("DETAIL_HEAD").Column), lSheetsDetail.Cells(DETAIL_ROW, DETAIL_COLUMN - 1))
        .RowHeight = 25
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
        .Font.Bold = True

        .Interior.ColorIndex = 35
        .Interior.Pattern = xlSolid
    
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeTop).ColorIndex = xlAutomatic
        
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeRight).ColorIndex = xlAutomatic
        
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideVertical).ColorIndex = xlAutomatic
        
    End With

'сохраним параметры
    Call saveParam

'создадим заголовок на SQLDATA2
'    min = Me.ListView1.ListItems.count + 1
    
'    j = 1
'    Do
'        flag = True
'        For i = 1 To Me.ListView1.ListItems.count
'            If Me.ListView1.ListItems(i).Checked Then
'                If Me.ListView1.ListItems(i).Tag < min Then
'                    min = Me.ListView1.ListItems(i).Tag
'                    Me.ListView1.ListItems(i).Checked = False
'                    id = i
'                End If
'                flag = False
'            End If
'        Next
'        If flag Then Exit Do
'        Me.ListView1.ListItems(id).Checked = False
'        min = Me.ListView1.ListItems.count + 1
'        Sheets("SQLData2").Cells(1, j) = Me.ListView1.ListItems(id).SubItems(1)
'        j = j + 1
'    Loop
    
    
    pbFormCancel = True
    Me.Hide
Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.CommandButton10_Click")
End Sub

Private Sub CommandButton12_Click()
Dim i

On Error GoTo doError
    
    linkCode = ""
    For i = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.List(i, 1) = "Все строки"
    Next

Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.CommandButton12_Click")
End Sub

Private Sub CommandButton13_Click()
    Call saveParam
End Sub

Private Sub CommandButton15_Click()
    Call sprav
End Sub

Private Sub CommandButton16_Click()
On Error GoTo doError
    
    Call SEEK_POP_GET_DATA(2, False)
    If pbFormCancel Then
        Me.TextBox1 = SEEK_POP.pcRetText
        linkRow = SEEK_POP.pcRetLink
        If Sheets("Service").Range("A36") <> 1 Then CommandButton10.Enabled = True
    End If
    Unload SEEK_POP

Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.CommandButton16_Click")
End Sub

Private Sub CommandButton5_Click()
    Move_Item (1)
    Me.ListView1.SetFocus
End Sub

Private Sub CommandButton6_Click()
    Move_Item (2)
    Me.ListView1.SetFocus
End Sub

Private Sub CommandButton7_Click()
    'Me.ListView1.HotTracking
    While Me.ListView1.ListItems.count > 0
        Me.ListView1.SetFocus
        Call Del_Item_Cond
    Wend
    Call listView1_init(True)
End Sub

Private Sub CommandButton8_Click()
    Call Del_Item_Cond
    Me.ListView1.SetFocus
End Sub

Private Sub CommandButton9_Click()
    pbFormCancel = False
    Me.Hide
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call sprav
End Sub

Private Sub UserForm_Initialize()
    Call listView1_init(False)
    Call listBox1_init(False)
    If Sheets("Service").Range("A36") = 1 Then
        CommandButton13.Enabled = True
        CommandButton9.Caption = "Выход"
    End If
End Sub
'Процедура удаления условия из списка
Public Sub Del_Item_Cond()

On Error GoTo doError
 
 If Me.ListView1.ListItems.count > 0 Then
    With Me
        .ListView1.ListItems.Remove (.ListView1.SelectedItem.Key)
        If .ListView1.ListItems.count = 0 Then
    '        .CmdUp.Enabled = False
    '        .CmdDown.Enabled = False
    '        .TlbCondition.Buttons("B2").Enabled = False
    '        .TlbCondition.Buttons("B3").Enabled = False
    '        .CmdSAVE.Enabled = True
    '        .CmdTest.Enabled = False
        Else
            .ListView1.ListItems(1).Selected = True
    '        Call .LstOtbor_KeyDown(10, 0)
            .ListView1.ListItems(1).EnsureVisible
    '        .CmdSAVE.Enabled = True
    '        .CmdTest.Enabled = True
        End If
    '    .CmdReset.Enabled = True
        
    End With
End If

Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.Del_Item_Cond")
End Sub

Public Sub ListView1_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
With Me
    If KeyCode = 13 Then ' Редактирование
        'If Me.ListView1.ListItems.count = 0 Then Me.Add_Item_Cond Else Me.Edit_Item_Cond
        'If Me.ListView1.ListItems.count <> 0 Then Me.LstOtbor.SetFocus
    End If
End With
End Sub

'flag = true -сброс
Public Sub listView1_init(flag As Boolean)
Dim i, j As Integer
Dim table_spr_row, table_spr_column
Dim sheetsService
    
On Error GoTo doError
     
    Set sheetsService = Sheets("Service")
    table_spr_row = sheetsService.Range("DETAIL_FIELDS").row
    table_spr_column = sheetsService.Range("DETAIL_FIELDS").Column
    
    
    
    i = table_spr_row
    j = 1
    While VBA.Trim(sheetsService.Cells(i, table_spr_column)) <> ""
            If ((sheetsService.Cells(i, table_spr_column - 2) And 4) <> 0) Or flag Then
                ListView1.ListItems.Add j, "k" + VBA.Trim(VBA.str(j)), VBA.Trim(sheetsService.Cells(i, table_spr_column + 1)) + ""
                ListView1.ListItems("k" + VBA.Trim(VBA.str(j))).SubItems(1) = VBA.Trim(sheetsService.Cells(i, table_spr_column)) + "1"
                
                If ((sheetsService.Cells(i, table_spr_column - 2) And 1) <> 0) Or flag Then
                    ListView1.ListItems("k" + VBA.Trim(VBA.str(j))).Checked = True
                Else
                    ListView1.ListItems("k" + VBA.Trim(VBA.str(j))).Checked = False
                End If
                j = j + 1
            End If
            
'            If ((sheetsService.Cells(i, table_spr_column - 2) And 8) <> 0) Or flag Then
'                ListView1.ListItems.Add j, "k" + VBA.Trim(VBA.str(j)), VBA.Trim(sheetsService.Cells(i, table_spr_column + 2)) + " (наименование)"
'                ListView1.ListItems("k" + VBA.Trim(VBA.str(j))).SubItems(1) = VBA.Trim(sheetsService.Cells(i, table_spr_column + 10))
'                If ((sheetsService.Cells(i, table_spr_column - 2) And 2) <> 0) Or flag Then
'                    ListView1.ListItems("k" + VBA.Trim(VBA.str(j))).Checked = True
'                Else
'                    ListView1.ListItems("k" + VBA.Trim(VBA.str(j))).Checked = False
'                End If
'                j = j + 1
'            End If
            i = i + 1
    Wend
Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.listView1_init")
End Sub

Public Sub listBox1_init(flag As Boolean)
Dim table_spr_column, table_spr_row, str As String, j
On Error GoTo doError

    table_spr_row = Sheets("Service").Range("DETAIL_FIELDS").row
    table_spr_column = Sheets("Service").Range("DETAIL_FIELDS").Column
     'Me.ListBox1.Column(0) = "Графа"
    'Me.ListBox1.Column(2) = "Условие отбора"
    Me.ListBox1.AddItem ("Код строки")
    Me.ListBox1.List(0, 2) = 1
    If (VBA.Trim(Sheets("Service").Cells(table_spr_row, table_spr_column - 1)) = "") Or flag Then
        Me.ListBox1.List(0, 1) = "Все строки"
        linkCode = ""
    Else
        str = VBA.Trim(Sheets("Service").Cells(table_spr_row, table_spr_column - 1))
        j = 0
        linkCode = str
        While VBA.Trim(str <> "")
            If getNextSubstr(str, ",") <> "" Then j = j + 1
        Wend
        Me.ListBox1.List(0, 1) = "Отобрано " + VBA.Trim(VBA.str(j)) + " строк(и)"
    End If
    
    'иниц. графы
    linkRow = Sheets("Service").Cells(table_spr_row, table_spr_column - 3)
    If VBA.Trim(linkRow) <> "" Then
        With Sheets("Service")
            .Range(.Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN), .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + KRIT_GRAF_COLUMNCOUNT - 2)) = ""
            .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = linkRow
            .Cells(KRIT_GRAF_ROW + 2, KRIT_GRAF_COLUMN).CALCULATE
            TextBox1.Text = .Cells(KRIT_GRAF_ROW + 2, KRIT_GRAF_COLUMN)
            .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = ""
        End With
        If Sheets("Service").Range("A36") <> 1 Then CommandButton10.Enabled = True
    End If
Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.listBox1_init")
End Sub

Public Sub sprav()
Dim str, table_spr_column, table_spr_row, i

On Error GoTo doError
     
     If Me.ListBox1.ListIndex <> -1 Then
        table_spr_row = Sheets("Service").Range("TABLE_SPR").row
        table_spr_column = Sheets("Service").Range("TABLE_SPR").Column
        
        With SEEK_POP
            Load SEEK_POP
            .lbMulti = True
            .lnWhatLoad = 1
            .Form_init
            'отметим что уже выбрано
            If linkCode = "" Then
                str = Sheets("Service").Cells(table_spr_row, table_spr_column - 1)
            Else
                str = linkCode
            End If
            For i = 1 To .LstFormula.ListItems.count
                If VBA.InStr(str, "," + VBA.Trim(.LstFormula.ListItems(i).Tag) + ",") <> 0 Then
                    .LstFormula.ListItems(i).Checked = True
                End If
            Next
            .Show
        End With
            
        If pbFormCancel Then
            Me.ListBox1.List(Me.ListBox1.ListIndex, 1) = SEEK_POP.pcRetValue
            If SEEK_POP.pcCount > 1 Then
                linkCode = ","
                For Each str In SEEK_POP.pcRetArrayLink
                    linkCode = linkCode + str + ","
                Next
            Else
                If SEEK_POP.pcCount = 1 Then
                    linkCode = "," + SEEK_POP.pcRetLink + ","
                End If
            End If
            If Sheets("Service").Range("A36") <> 1 Then CommandButton10.Enabled = True
        End If
    End If
    Unload SEEK_POP

Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.sprav")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    pbFormCancel = False
End Sub

Sub saveParam()
Dim i, sheetsService As Object, j, str, sum
Dim table_spr_column, table_spr_row

On Error GoTo doError

    Set sheetsService = Sheets("Service")
    table_spr_row = sheetsService.Range("DETAIL_FIELDS").row
    table_spr_column = sheetsService.Range("DETAIL_FIELDS").Column
    
    'сброс всего
    i = table_spr_row
    While sheetsService.Cells(i, table_spr_column) <> ""
        sheetsService.Cells(i, table_spr_column - 2) = 0
        i = i + 1
    Wend
    
    For i = 1 To Me.ListView1.ListItems.count

        'ищем в таблице
        j = table_spr_row
        str = Me.ListView1.ListItems(i).SubItems(1)
        
        If VBA.Right(str, 1) = "1" Then 'код
            sum = 4
            str = VBA.Left(str, VBA.Len(str) - 1)
        Else
            sum = 8
        End If
        While (sheetsService.Cells(j, table_spr_column) <> str) And (sheetsService.Cells(j, table_spr_column) <> "")
            j = j + 1
        Wend
        If Me.ListView1.ListItems(i).Checked Then
            If sum = 8 Then
                sheetsService.Cells(j, table_spr_column - 2) = sheetsService.Cells(j, table_spr_column - 2) + sum + 2
            Else
                sheetsService.Cells(j, table_spr_column - 2) = sheetsService.Cells(j, table_spr_column - 2) + sum + 1
            End If
        Else
            sheetsService.Cells(j, table_spr_column - 2) = sheetsService.Cells(j, table_spr_column - 2) + sum
        End If
nnn:
    Next
    
    sheetsService.Cells(table_spr_row, table_spr_column - 1) = linkCode
    sheetsService.Cells(table_spr_row, table_spr_column - 3) = linkRow

Exit Sub
doError:
    Call ERROR_EVENT("DetailParam.save")
End Sub
