'Описание 'Скрип иллюстрирует использование элемента "список" с функцие Dialog 'для выбора множества переменных из файла данных SPSS. 'После выбора программа отображает отобранные переменные в виде сообщения. 'Он отличается от VarListDemo2 тем, что использует функцию и статические переменные чтобы избежать 'использования глобальных переменных. 'Это упрощает встраивание кода в вашу программу, использование его. Больше ничем не отличается. 'Конец описания 'потребуем явного определения переменных перед их использованием Option Explicit 'демонстрирует использование функции MultipleVariableSelectionDialog Sub Main 'будем вызывать функцию, которая вернёт выбранные переменные из того массива, который мы передадим ей. Dim strVarsSelected() As String 'индексная переменная цикла Dim i As Integer 'используем эту строку для отображения результата Dim strTemp As String 'эта функция имеет значение True (Истина), если выбрана минимум одна переменная, 'и False (Ложь), если пользователь нажал "Отмена" If MultipleVariableSelectionDialog(strVarsSelected()) Then 'это просто демонстрация. Мы сделаем строку из имён выбранных переменных и отобразим её. '(Мы могли составить эту функцию так, чтобы пустая строка означала отмену вместо вывода отдельного сообщения) For i = LBound(strVarsSelected) To UBound(strVarsSelected) strTemp = strTemp & strVarsSelected(i) & vbCrLf Next MsgBox strTemp, vbInformation, "Выбрали переменные" Else MsgBox "Процедура отменена.", vbExclamation, _ "Переменные не выбраны" End If End Sub 'мы поместим выбранные переменные в массив, передаваемый как параметр функции 'функция вернёт значение False, если пользователь отменил выбор, 'либо True, если пользователь нажал OK после выбора не менее одной переменной. Function MultipleVariableSelectionDialog(strVarsSelected() As String) As Boolean 'мы подключим наши массивы к элементам listbox диалога 'вообще, функция диалога будет инициализировать массивы, но мы 'должны подключить к ней именно строковые массивы, иначе возникнет ошибка. Dim strVariables() As String ReDim strVariables(0) 'реинициализируем массив выбранных переменных, чтобы очистить его на всякий случай. ReDim strVarsSelected(0) 'сделаем "красиво": выведем путь к файлу данных Dim strFilePath As String 'путь к файлу strFilePath = objSpssApp.Documents.GetDataDoc(0).GetDocumentPath 'если файл ещё ни разу не сохранялся If strFilePath = "" Then strFilePath = "(Untitled)" End If 'Чтобы отредактировать диалоговое окно, поместите курсор между строками 'Begin Dialog и End Dialog и вызовите Dialog Editor. 'По умолчанию редактор диалогов создаёт шаблон с именем массива ListArray() 'в качестве параметра для списка ListBox; мы заменили его на имя нашего массива - strVariables. 'Чтобы начать редактировать свойства диалога используйте правую кнопку мыши, либо кнопку на панели инструментов. 'Используйте стрелки << и >> для перемещения между элементами. 'Зададим имя функции в свойстве Dialog Function, 'и когда сохраним диалог, нам будет предложено сгенерировать шаблон 'мониторинговой функции (следящей за диалогом). См. функцию VarListDialogFunc ниже. Begin Dialog UserDialog 490,203,"Выбор нескольких переменных - Демо",.VarListDialogFunc GroupBox 10,7,470,189,strFilePath,.GroupBox1 OKButton 340,161,120,21 CancelButton 220,161,110,21 PushButton 210,35,90,21," Выбрать >> ",.PushButtonAdd PushButton 210,63,90,21,"<< Убрать ",.PushButtonRemove ListBox 20,21,180,168,strVariables(),.ListBoxVars ListBox 300,21,160,133,strVarsSelected(),.ListBoxVarsSelected End Dialog 'Нажатие кнопки Отмена вызовет ошибку, поэтому перед вызовом диалога надо 'установить метку, чтобы программа перепрыгнула на обработку ошибки. On Error GoTo UserCancel Dim dlg As UserDialog 'вызов диалога. Dialog dlg 'мы использовали вспомогательную функцию при работе диалога чтобы сохранять 'имена переменных. Запросим их теперь. strVarsSelected() = SelectedVariableArray("", False) 'возвращаем true, т.к. пользователь нажал OK MultipleVariableSelectionDialog = True Exit Function 'обработка ошибки UserCancel: 'в вашем случае вы можете прописать здесь выдачу сообщения пользователю. 'Здесь мы просто возвращаем пустую строку. Дальнейшие действия программы будут зависеть от 'того, как устроена процедура, вызвавшая данную функцию. Debug.Print "Error" & Err & vbCrLf & Err.Description ReDim strVarsSelected(0) MultipleVariableSelectionDialog = False End Function Rem См. подсказку по теме DialogFunc для более подробной информации. 'Функция мониторинга диалога вызывается постоянно, пока отображается диалог. 'Когда эта функция вернёт значение False, окно диалога будет закрыто. Private Function VarListDialogFunc(DlgItem$, Action%, SuppValue%) As Boolean 'статичные переменные сохраняют свои значения при повторных вызовах функции 'мы будем их использовать, чтобы отслеживать, какие переменные были выбраны Static strVars() As String Static strVarsSelected() As String 'индексная переменная цикла Dim i As Integer Select Case Action% Case 1 ' Инициализация диалога Call InitVariables(strVars) DlgListBoxArray "ListBoxVars", strVars() ReDim strVarsSelected(0) DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() DlgEnable "OK", False DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0) DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0) Case 2 ' Изменение значения или нажатие кнопки If DlgItem$ = "PushButtonAdd" Then Call MoveItem(DlgValue("ListBoxVars"), strVars(), strVarsSelected()) DlgListBoxArray "ListBoxVars", strVars() DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() DlgEnable "OK", True VarListDialogFunc = True ' Запрет на закрытие диалога после нажатия кнопки ElseIf DlgItem$ = "PushButtonRemove" Then Call MoveItem(DlgValue("ListBoxVarsSelected"), strVarsSelected(), strVars()) DlgListBoxArray "ListBoxVars", strVars() DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() DlgEnable "OK", (strVarsSelected(0) <> "") VarListDialogFunc = True ' Запрет на закрытие диалога после нажатия кнопки ElseIf DlgItem$ = "OK" Then 'сохраняем массив, игнорируем результат функции Call SelectedVariableArray(strVarsSelected(), True) End If Rem VarListDialogFunc = True ' Запрет на закрытие диалога после нажатия кнопки Case 3 ' Измненеие текста в элементах TextBox или ComboBox Case 4 ' Смена фокуса Case 5 ' Ожидание DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0) DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0) VarListDialogFunc = True 'Отображение диалога продолжается - программа ожидает End Select End Function Sub InitVariables(strVars() As String) 'As Variant 'список переменных - свойство объекта Info. Dim objInfo As ISpssInfo 'Dim strVars() As String 'индексная переменная цикла Dim i As Integer 'нам потребуется знать число переменных Dim intNumVariables As Integer Set objInfo = objSpssApp.SpssInfo 'имена будут помещены в массив с индексами от 0 до .NumVariables - 1 intNumVariables = objInfo.NumVariables If intNumVariables > 0 Then 'расширяем массив до числа переменных ReDim strVars(intNumVariables - 1) 'читаем имена переменных в массив For i = 0 To intNumVariables - 1 'если надо, можно работать с метками вместо имён, либо и с теми и с другими strVars(i) = objInfo.VariableAt(i) 'strVars(i) = objInfo.VariableLabelAt(i) 'strVars(i) = objInfo.VariableAt(i) & ": " & objInfo.VariableLabelAt(i) Next Else 'массив с одной пустой строкой ReDim strVars(0) End If 'InitVariables = strVars End Sub 'вспомогательная процедура, вызываемая при перемещении имён переменных между списками; 'в ней нет процедур контроля данных, т.к. она вызывается лишь из функции диалога. Параметр 'intItem будет в пределах размера массива. Sub MoveItem(intItem As Integer, strFrom() As String, strTo() As String) Dim i As Integer Dim intUpper As Integer 'добавление элемента в массив-приёмщик intUpper = UBound(strTo) Debug.Print strTo(intUpper); intUpper; intItem 'расширяем массив, но сохраняем уже имеющееся содержимое If strTo(intUpper)="" Then intUpper=-1 ReDim Preserve strTo(intUpper + 1) strTo(intUpper + 1) = strFrom(intItem) 'удаление элемента из массива-источника intUpper = UBound(strFrom) 'копируем элементы после выбранного на одну позицию выше For i = intItem To intUpper - 1 strFrom(i) = strFrom(i + 1) Next If intUpper > 0 Then 'сохраняем всё, кроме последнего элемента ReDim Preserve strFrom(intUpper - 1) Else 'реинициализируем массив, оставляя в нём одну пустую строчку ReDim strFrom(0) End If End Sub 'Это дешёвая уловка позволяет избежать использования глобальной переменной для 'извлечения списка переменных из функции мониторинга диалога. 'Функция сохраняет значение своего параметра когда вызвана с параметром blnStore=True и 'возвращает то, что было сохранено ранее как свой результат. 'Это упрощает встраивание данного кода в вашу программу, т.к. не требуется добавлять глобальную переменную 'в ваш проект чтобы данный диалог работал. Function SelectedVariableArray(vntStore As Variant, blnStore As Boolean) As Variant Static vntStored As Variant SelectedVariableArray = vntStored 'принимаем на хранение только массивы со строками If blnStore Then If IsArray(vntStore) Then If VarType(vntStore(0)) = vbString Then vntStored = vntStore End If End If End If End Function