TopPicLogo TopPicText

Список (ListBox) - Построение инструкции In (...) по списку с мультивыделением

Public Function esListValues(ListCtrl As ListBox, Optional IsNumbers As Boolean) As String
'es 03.12.2012
'Возвращает список значений списка с мультивыделением
'   разделенный запятыми внутри выражения In(...) или Not In (...)
'   в зависимости от соотношения ВЫДЕЛЕННОГО и НЕ ВЫДЕЛЕННОГО
'   для дальнейшего использования при отборе записей:
'   WHERE [Имя Поля] In ([Список Значений])
'Параметр IsNumbers:
'   False = список содержит текстовые значения (по умолч.)
'   True  = числовые значения
'Если выделно ВСЁ или НИЧЕГО - возвращает "Not In (Null)"
'--------------------------------------------------------------------
Dim idx As Integer          ' Индекс значения списка
Dim useSelected As Boolean  ' Что собираем - ВЫДЕЛЕННОЕ или НЕ ВЫДЕЛЕННОЕ
Dim strIN As String         ' Выражение - In (...) или Not In (...)
'--------------------------------------------------------------------

On Error GoTo ListValuesErr

'Проверка на наличие выбранных элем. списка
    If ListCtrl.ItemsSelected.Count = 0 Then
        esListValues = "Not In (Null)"
        GoTo ListValuesBye
    End If
    
'На случай если выделены ВСЕ значения
    If ListCtrl.ItemsSelected.Count = CInt(ListCtrl.ListCount) Then 'выделены ВСЕ значения
        esListValues = "Not In (Null)"
        GoTo ListValuesBye
    End If

'Определяем чего больше ВЫДЕЛЕННОГО или НЕ ВЫДЕЛЕННОГО
    If ListCtrl.ItemsSelected.Count <= CInt(ListCtrl.ListCount / 2) Then
        useSelected = True
        strIN = "In ("
    Else
        useSelected = False
        strIN = "Not In ("
    End If

'Сборка строки
    For idx = 0 To ListCtrl.ListCount - 1
        If ListCtrl.Selected(idx) = useSelected Then
            If IsNumbers = False Then 'текстовые значения
                esListValues = esListValues & ",'" & ListCtrl.ItemData(idx) & "'"
            Else 'числовые значения
                esListValues = esListValues & "," & ListCtrl.ItemData(idx)
            End If
        End If
    Next idx
    
    If esListValues <> "" Then  'формируем выражение ...
        esListValues = strIN & Mid(esListValues, 2) & ")"
    Else
        esListValues = "Not In (Null)"
    End If

ListValuesBye:
    Exit Function
ListValuesErr:
    MsgBox "Произошла ошибка выполнения функции esListValues!" & vbCrLf & _
    Err.Description & " - #" & Err.Number, vbCritical, "Ошибка"
    Resume ListValuesBye
End Function



Ещё Вариант:

Автор: Ким Владимир kim@intercare.ru

Владимир предложил более функциональный вариант относительно предыдущего аналога
(Добавлена обработка Null, других типов данных, а также случай, когда выделено все.)

Option Compare Database
Option Explicit
 Public Enum vkFieldFormat
    vbInteger = 2
    vbLong = 3
    vbByte = 17
    vbDate = 7
    vbDateTimeJ = 77
    vbSingle = 4
    vbDouble = 5
    vbCurrency = 6
    vbString = 8
    vbBoolean = 11
End Enum

Public Function vkListValues(ListCtrl As ListBox, Optional dtFormat As vkFieldFormat = 3) As String
'Возвращает список значений списка с мультивыделением
'разделенный запятыми внутри выражения In(...) или Not In (...)
'  в зависимости от соотношения ВЫДЕЛЕННОГО и НЕ ВЫДЕЛЕННОГО
'Параметр dtFormat: long as default = 3
'--------------------------------------------------------------------
Dim idx As Integer          'индекс значения списка
Dim useSelected As Boolean  'Что собираем - ВЫДЕЛЕННОЕ или НЕ ВЫДЕЛЕННОЕ
Dim strIN As String         'выражение - In (...) или Not In (...)
On Error GoTo ListValuesErr
'Проверка на наличие выбранных элем. списка
    If ListCtrl.ItemsSelected.Count = 0 Then GoTo ListValuesBye
'Определяем чего больше ВЫДЕЛЕННОГО или НЕ ВЫДЕЛЕННОГО
    If (ListCtrl.ItemsSelected.Count < CInt(ListCtrl.ListCount / 2)) _
    And (ListCtrl.ItemsSelected.Count <> CInt(ListCtrl.ListCount)) Then
        useSelected = True
        strIN = "In ("
    Else
        useSelected = False
        strIN = "Not In ("
    End If
'Сборка строки
    For idx = 0 To ListCtrl.ListCount - 1
        If ListCtrl.Selected(idx) = useSelected Then
        If IsNull(ListCtrl.ItemData(idx)) Or Len(ListCtrl.ItemData(idx)) = 0 Then
            vkListValues = vkListValues & ",Null"
        Else
            Select Case dtFormat
            Case 8  'текстовые значения
            vkListValues = vkListValues & ",'" & Replace(ListCtrl.ItemData(idx), """", """""") & "'"
            Case 2, 3, 17 'числовые значения
            vkListValues = vkListValues & "," & ListCtrl.ItemData(idx)
            Case 7 'date значения
            vkListValues = vkListValues & ",#" & Format(ListCtrl.ItemData(idx), "m\/d\/yyyy") & "#"
            Case 77 'dateTime значения
            vkListValues = vkListValues & ",#" & Format(ListCtrl.ItemData(idx), "m\/d\/yyyy n\:h\:s") & "#"
            Case 11 'boolean значения
            vkListValues = vkListValues & "," & IIf(ListCtrl.ItemData(idx), "True", "False") & "#"
            Case 4, 5, 6 'с десятичной точкой
            vkListValues = vkListValues & "," & Replace(CStr(ListCtrl.ItemData(idx)), ",", ".")
            Case Else
            vkListValues = " Конструкция In (...) для такого типа данных не предусмотрена"
            Exit Function
            End Select
        End If
        End If
    Next idx
    vkListValues = strIN & Mid(vkListValues, 2) & ")" 'формируем выражение ....
ListValuesBye:
    Exit Function
ListValuesErr:
    MsgBox "Произошла ошибка выполнения функции vkListValues!" & vbCrLf & _
    Err.Description & " - #" & Err.Number, vbCritical, "Ошибка"
    Resume ListValuesBye
End Function



Picture






Скачать

MSA-2007 ( 41 kB) Пример


Назад ToTop
L.E. 28.03.2017
Рейтинг@Mail.ru