Список (ListBox) - Построение инструкции In (...) по списку с множественным выборомPrivate Function ListSelectedValuesToIN(ListCtrl As ListBox, Optional IsNumbers As Boolean) As String 'es 03.12.2012 - LE 14.09.2021 - v003 'Возвращает список значений списка с мультивыделением ' разделенный запятыми внутри выражения In(...) или Not In (...) ' в зависимости от соотношения ВЫДЕЛЕННОГО и НЕ ВЫДЕЛЕННОГО ' для дальнейшего использования при отборе записей: ' WHERE [Имя Поля] In ([Список Значений]) 'Параметр IsNumbers: ' False = список содержит текстовые значения (по умолч.) ' True = числовые значения 'Если выделно ВСЁ или НИЧЕГО - возвращает "" '-------------------------------------------------------------------- Dim idx As Integer ' Индекс значения списка Dim useSelected As Boolean ' Что собираем - ВЫДЕЛЕННОЕ или НЕ ВЫДЕЛЕННОЕ Dim strIN As String ' Выражение - In (...) или Not In (...) Dim sVal$ '-------------------------------------------------------------------- On Error GoTo ListValuesErr 'Проверка на наличие выбранных элем. списка If ListCtrl.ItemsSelected.Count = 0 Then ListSelectedValuesToIN = "" GoTo ListValuesBye End If 'На случай если выделены ВСЕ значения If ListCtrl.ItemsSelected.Count = CInt(ListCtrl.ListCount) Then 'выделены ВСЕ значения ListSelectedValuesToIN = "" 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 'текстовые значения ListSelectedValuesToIN = ListSelectedValuesToIN & ",'" & ListCtrl.ItemData(idx) & "'" Else 'числовые значения sVal = ListCtrl.ItemData(idx) sVal = Replace(sVal, ",", ".") ListSelectedValuesToIN = ListSelectedValuesToIN & "," & sVal End If End If Next idx If ListSelectedValuesToIN <> "" Then 'формируем выражение ... ListSelectedValuesToIN = strIN & Mid(ListSelectedValuesToIN, 2) & ")" Else ListSelectedValuesToIN = "" End If ListValuesBye: Exit Function ListValuesErr: MsgBox "Произошла ошибка выполнения функции ListSelectedValuesToIN!" & vbCrLf & _ Err.Description & " - #" & Err.Number, vbCritical, "Ошибка" Resume ListValuesBye End Function
Автор: Ким Владимир kim@intercare.ru Владимир предложил более функциональный вариант относительно предыдущего аналога 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) Пример |
|||
L.E. 14.09.2021 |