VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ADDCOND 
   Caption         =   "Дополнительные условия отбора"
   ClientHeight    =   3180
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6570
   OleObjectBlob   =   "ADDCOND.frx":0000
   StartUpPosition =   1  'ПоЦентруВладельца
End
Attribute VB_Name = "ADDCOND"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Conds() As String

Private Sub CommandButton1_Click()
Dim sheetsService As Object, i, table_spr_row, table_spr_column, j, str As String, code
Dim sheetssqlData1 As Object, kritColumn, razdelColumn, LookRange As Range, row, sheetsReport As Object
    
On Error GoTo doError
    
    Application.ScreenUpdating = False
    Set sheetsReport = ActiveSheet
    Set sheetsService = Sheets("Service")
    Set sheetssqlData1 = Sheets("SQLData1")
    table_spr_row = sheetsService.Range("TABLE_SPR").row + 1
    table_spr_column = sheetsService.Range("TABLE_SPR").Column
'сохраним данные на листе Service
    For i = 0 To Me.ListBox1.ListCount - 1
        'найдем значение
        j = table_spr_row
        While (Val(sheetsService.Cells(j, table_spr_column)) <> Me.ListBox1.List(i, 2)) And (VBA.Trim(sheetsService.Cells(j, table_spr_column)) <> "")
            j = j + 1
        Wend
        sheetsService.Cells(j, table_spr_column - 1) = Conds(i)
        Conds(i) = ""
    Next
    
'обновим выборку
    ' сделаем загрузку данных
    Call GetSQLData_CALC
    sheetsService.Range("A25") = 1
    
'Накладываем на выборку условия
    Set LookRange = sheetssqlData1.Range(sheetssqlData1.Cells(KRIT_SQLDATA1_ROW, KRIT_SQLDATA1_COLUMN), sheetssqlData1.Cells(KRIT_SQLDATA1_ROW, KRIT_SQLDATA1_COLUMN + KRIT_SQLDATA1_COLUMNCOUNT + 1)).Find("RAZDEL", LookIn:=xlFormulas, lookat:=xlWhole)
    If Not LookRange Is Nothing Then
        razdelColumn = LookRange.Column 'IIf(Sheets("Service").Range("B23").Value > 1, VBA.Val(VBA.Trim(VBA.str(lnColumnCell - pnAddress_Col + 1))), VBA.str(lnColumnCell - pnAddress_Col + 1))
    Else
        Exit Sub
    End If
    
    While VBA.Trim(sheetsService.Cells(table_spr_row, table_spr_column)) <> ""
        str = VBA.Trim(sheetsService.Cells(table_spr_row, table_spr_column - 1))
        If str <> "" Then
            row = KRIT_SQLDATA1_ROW + 1
            Set LookRange = sheetssqlData1.Range(sheetssqlData1.Cells(KRIT_SQLDATA1_ROW, KRIT_SQLDATA1_COLUMN), sheetssqlData1.Cells(KRIT_SQLDATA1_ROW, KRIT_SQLDATA1_COLUMN + KRIT_SQLDATA1_COLUMNCOUNT + 1)).Find(sheetsService.Cells(table_spr_row, table_spr_column + 10), LookIn:=xlFormulas, lookat:=xlWhole)
            If Not LookRange Is Nothing Then
                kritColumn = LookRange.Column
                While str <> ""
                    code = getNextSubstr(str, "|")
                    If code <> "" Then
                        sheetssqlData1.Cells(row, kritColumn) = code
                        sheetssqlData1.Cells(row, razdelColumn) = "<>"""""
                        row = row + 1
                    End If
                Wend
                'выполнить фильтрацию
                Range("TABLE_SQLDATA1").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
                    (sheetssqlData1.Cells(KRIT_SQLDATA1_ROW, KRIT_SQLDATA1_COLUMN), sheetssqlData1.Cells(row - 1, KRIT_SQLDATA1_COLUMN + KRIT_SQLDATA1_COLUMNCOUNT - 1)) _
                    , CopyToRange:=Range("COPY_SQLDATA1"), Unique:=False
                sheetssqlData1.Range("COPY_SQLDATA1").Copy (sheetssqlData1.Range("TABLE_SQLDATA1"))
                'отчистим критерий
                sheetssqlData1.Range(sheetssqlData1.Cells(KRIT_SQLDATA1_ROW + 1, KRIT_SQLDATA1_COLUMN), sheetssqlData1.Cells(row - 1, KRIT_SQLDATA1_COLUMN + KRIT_SQLDATA1_COLUMNCOUNT - 1)) = ""
            End If
        End If
        table_spr_row = table_spr_row + 1
    Wend
    Set LookRange = Nothing
    
    Me.Hide
    sheetsReport.Activate
    Application.ScreenUpdating = True

Exit Sub
doError:
    Call ERROR_EVENT("ADDCOND.CommandButton1_Click")
End Sub

Private Sub CommandButton2_Click()
    Me.Hide
End Sub

Private Sub CommandButton4_Click()
Dim i
    For i = 0 To Me.ListBox1.ListCount - 1
        Conds(i) = ""
        Me.ListBox1.List(i, 1) = "Все строки"
    Next
End Sub

Private Sub ListBox1_Click()

End Sub

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

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
    Call initList
End Sub

Sub initList()
Dim table_spr_row, table_spr_column, i, str As String, j
Dim sheetsService As Object
    
On Error GoTo doError
    
    Set sheetsService = Sheets("Service")
    table_spr_row = sheetsService.Range("TABLE_SPR").row + 1
    table_spr_column = sheetsService.Range("TABLE_SPR").Column
    
    i = 0
    While VBA.Trim(sheetsService.Cells(table_spr_row, table_spr_column)) <> ""
        If sheetsService.Cells(table_spr_row, table_spr_column + 1) <> -1 Then
            Me.ListBox1.AddItem (sheetsService.Cells(table_spr_row, table_spr_column + 2).Text)
            Me.ListBox1.List(i, 2) = sheetsService.Cells(table_spr_row, table_spr_column)
            i = i + 1
        End If
        table_spr_row = table_spr_row + 1
    Wend
    ReDim Conds(i)
    
    i = 0
    table_spr_row = sheetsService.Range("TABLE_SPR").row + 1
    While VBA.Trim(sheetsService.Cells(table_spr_row, table_spr_column)) <> ""
        If sheetsService.Cells(table_spr_row, table_spr_column + 1) <> -1 Then
            Conds(i) = VBA.Trim(sheetsService.Cells(table_spr_row, table_spr_column - 1).Text)
            If Conds(i) = "" Then
                Me.ListBox1.List(i, 1) = "Все строки"
            Else
                str = Conds(i)
                j = 0
                While VBA.Trim(str <> "")
                    If getNextSubstr(str, "|") <> "" Then j = j + 1
                Wend
                Me.ListBox1.List(i, 1) = "Отобрано " + VBA.Trim(VBA.str(j)) + " строк(и)"
            End If
            i = i + 1
        End If
        table_spr_row = table_spr_row + 1
    Wend

Exit Sub
doError:
    Call ERROR_EVENT("ADDCOND.init_List")
End Sub

Sub sprav()
Dim pnCount, txt, i

On Error GoTo doError
     
     If Me.ListBox1.ListIndex <> -1 Then
        Call SHOW_SPRAV(Me.ListBox1.List(Me.ListBox1.ListIndex, 2), Me.ListBox1.ListIndex)
        If pbFormCancel Then
            pnCount = SEEK_POP.pcCount
            Me.ListBox1.List(Me.ListBox1.ListIndex, 1) = SEEK_POP.pcRetValue
            If pnCount <= 1 Then
                If pnCount = 1 Then
                    Conds(Me.ListBox1.ListIndex) = "|" + VBA.Trim(SEEK_POP.pcRetValue) + "|"
'                    listLink = VBA.str(SEEK_POP.pcRetLink)
                Else
'                    listLink = ""
                    Me.ListBox1.List(Me.ListBox1.ListIndex, 1) = "Все строки"
                End If
            Else
'                listLink = ""
                Conds(Me.ListBox1.ListIndex) = ""
                For Each i In SEEK_POP.pcRetArrayValue
                    Conds(Me.ListBox1.ListIndex) = Conds(Me.ListBox1.ListIndex) + "|" + VBA.Trim(i)
                Next
                Conds(Me.ListBox1.ListIndex) = Conds(Me.ListBox1.ListIndex) + "|"
            End If
            Unload SEEK_POP
        End If
    End If

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

Sub SHOW_SPRAV(ByVal WhatLoad As Integer, _
                      ByVal index As Integer)
Dim lcSQLCommand As String
Dim lnColumn As Long, lnRow As Long, lnColumnCount As Long, i As Integer
    
On Error GoTo doError
    
If WhatLoad > 2 Then ' Грузим справочники
    'Определим команду выборки
    With Sheets("Service")
        lnColumn = .Range("KRIT_SPR").Column
        lnRow = .Range("KRIT_SPR").row
        .Range(.Cells(lnRow + 1, lnColumn), .Cells(lnRow + 1, lnColumn + .Range("KRIT_SPR").Columns.count - 1)) = ""
        .Cells(lnRow + 1, lnColumn) = WhatLoad
        lcSQLCommand = .Cells(lnRow + 2, lnColumn)
        .Cells(lnRow + 1, lnColumn) = ""
    End With
    Call GetSQLData_SPR(lcSQLCommand)
End If
With SEEK_POP
    Load SEEK_POP
    .lbMulti = True
    .lnWhatLoad = WhatLoad
    .Form_init
    'отметим что уже выбрано
    For i = 1 To .LstFormula.ListItems.count
        If VBA.InStr(Conds(index), "|" + VBA.Trim(.LstFormula.ListItems(i).Text) + "|") <> 0 Then
            .LstFormula.ListItems(i).Checked = True
        End If
    Next
    .Show
End With

Exit Sub
doError:
    Call ERROR_EVENT("ADDCOND.SHOW_SPRAV")
End Sub
