Список (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

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