'Begin Description 'This script illustrates how to use a list box with a Dialog monitor function, 'to select multiple variables from an SPSS data file. 'It simply displays the selected variables in a message box when finished. 'End Description 'require variables to be dimensioned before use Option Explicit 'this needs to be a global variable so it can be modified 'by the dialog function Dim strVarsSelected() As String Sub Main 'we'll call a function which returns selected variables 'in an array of strings we pass it. 'loop control variable Dim i As Integer 'we'll use this string to display the result Dim strTemp As String 'the function result is True if one or more variables are selected 'False if the user presses cancel If MultipleVariableSelectionDialog(strVarsSelected()) Then 'this is just a demo, so we'll make a single string out of the 'variable names, and display it. (We could have written the 'function to return this as a string, with an empty string 'signifying Cancel.) For i = LBound(strVarsSelected) To UBound(strVarsSelected) strTemp = strTemp & strVarsSelected(i) & vbCrLf Next MsgBox strTemp, vbInformation, "Variables Selected" Else MsgBox "Operation Cancelled.", vbExclamation, _ "No Variables Selected" End If End Sub 'we'll put the selected variable names in the array passed as a parameter 'we'll return False as the function result if the user cancels, 'True if the user pressed OK after selecting at least one variable. Function MultipleVariableSelectionDialog(strVarsSelected() As String) As Boolean 'we'll pass string arrays to the dialog's listboxes 'actually, the dialog function will initialize the arrays Dim strVariables() As String ReDim strVariables(0) 're-initialize the Selected array, too ReDim strVarsSelected(0) 'we'll make things nice by displaying the name of the data file Dim strFilePath As String 'the path to the file strFilePath = objSpssApp.Documents.GetDataDoc(0).GetDocumentPath 'if the file hasn't been saved If strFilePath = "" Then strFilePath = "(Untitled)" End If 'Define and put up the dialog. 'To edit the dialog: position the cursor between Begin Dialog and 'End Dialog, then activate the Dialog Editor. 'Note that the dialog editor created a template with ListArray() 'as the ListBox parameter; it's been replaced by strVariables. 'Right-click on an item to edit its properties, or use the toolbar button. 'Use the << and >> arrows to cycle through items. 'Add a function name to the UserDialog's Dialog Function property, 'and when you save the dialog it will offer to generate the skeleton 'of the dialog monitor function. See VarListDialogMonitor function, below. Begin Dialog UserDialog 490,203,"Variable List Selection Demo",.VarListDialogFunc GroupBox 10,7,470,189,strFilePath,.GroupBox1 OKButton 340,161,120,21 PushButton 210,35,80,21," Add >>",.PushButtonAdd CancelButton 220,161,110,21 PushButton 210,63,80,21,"<< Remove",.PushButtonRemove ListBox 20,21,180,168,strVariables(),.ListBoxVars ListBox 300,21,160,133,strVarsSelected(),.ListBoxVarsSelected End Dialog 'the Cancel button will cause an error when pressed, 'so we need to set up error handling before putting up the dialog. On Error GoTo UserCancel Dim dlg As UserDialog 'We'll set the default choice to be item 0 dlg.ListBoxVars = 0 'this actually puts up the dialog. Dialog dlg 'we do a quick check to make sure variables were selected MultipleVariableSelectionDialog = True '(strVarsSelected(0) <> "") Exit Function 'here's the error handler UserCancel: 'in other circumstances, we might put up a message box. 'Here, we'll return an empty string. It's up to the caller 'of the function to respond appropriately. Debug.Print "Error" & Err & vbCrLf & Err.Description MultipleVariableSelectionDialog = False End Function Rem See DialogFunc help topic for more information. 'the Dialog Monitor is called repeatedly while the dialog is displayed. 'when it returns False, the dialog will close. Private Function VarListDialogFunc(DlgItem$, Action%, SuppValue%) As Boolean 'static variables retain their values between function invocations 'we'll use these to track which variables are selected Static strVars() As String 'Static strVarsSelected() As String 'loop control variable Dim i As Integer Select Case Action% Case 1 ' Dialog box initialization 'Dim strTemp() As String Call InitVariables(strVars) Debug.Print LBound(strVars); UBound(strVars) Debug.Print strVars(0); strVars(UBound(strVars)) DlgListBoxArray "ListBoxVars", strVars() ReDim strVarsSelected(0) DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() DlgEnable "OK", False DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0) DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0) VarListDialogFunc = False Case 2 ' Value changing or button pressed If DlgItem$ = "PushButtonAdd" Then Call MoveItem(DlgValue("ListBoxVars"), strVars(), strVarsSelected()) DlgListBoxArray "ListBoxVars", strVars() DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() DlgEnable "OK", True VarListDialogFunc = True ' Prevent button press from closing the dialog box ElseIf DlgItem$ = "PushButtonRemove" Then Call MoveItem(DlgValue("ListBoxVarsSelected"), strVarsSelected(), strVars()) DlgListBoxArray "ListBoxVars", strVars() DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() DlgEnable "OK", (strVarsSelected(0) <> "") VarListDialogFunc = True ' Prevent button press from closing the dialog box ' ElseIf dlgItem$ = "OK" Then ' DlgListBoxArray "ListBoxVarsSelected", strVarsSelected() End If Rem VarListDialogFunc = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle DlgEnable "PushButtonAdd", (DlgValue("ListBoxVars") >= 0) DlgEnable "PushButtonRemove", (DlgValue("ListBoxVarsSelected") >= 0) VarListDialogFunc = True ' Continue getting idle actions End Select End Function Sub InitVariables(strVars() As String) 'As Variant 'the variable list is a property of the Info object. Dim objInfo As ISpssInfo 'we'll return the array of strings in a variant 'Dim strVars() As String 'loop control variable Dim i As Integer 'we'll need to know how many variables there are Dim intNumVariables As Integer Set objInfo = objSpssApp.SpssInfo 'the variables are indexed by 0 to .NumVariables - 1 intNumVariables = objInfo.NumVariables If intNumVariables > 0 Then 'set aside enough storage for the array ReDim strVars(intNumVariables - 1) 'read in the variable names For i = 0 To intNumVariables - 1 'if we preferred, we could work with labels instead, or both strVars(i) = objInfo.VariableAt(i) 'strVars(i) = objInfo.VariableLabelAt(i) 'strVars(i) = objInfo.VariableAt(i) & ": " & objInfo.VariableLabelAt(i) Next Else 'array with one empty string ReDim strVars(0) End If 'InitVariables = strVars End Sub 'utility procedure for moving an item, omits checks because it's only 'called from the dialog function Sub MoveItem(intItem As Integer, strFrom() As String, strTo() As String) Dim i As Integer Dim intUpper As Integer 'add the item to the destination array intUpper = UBound(strTo) Debug.Print intUpper; intItem; strTo(intUpper) 'make sure we keep the current contents ReDim Preserve strTo(intUpper + 1) strTo(intUpper + 1) = strFrom(intItem) 'remove the item from the source array intUpper = UBound(strFrom) 'copy the items above the removed one position lower For i = intItem To intUpper - 1 strFrom(i) = strFrom(i + 1) Next If intUpper > 0 Then 'keep all but the last element ReDim Preserve strFrom(intUpper - 1) Else 'this will re-initialize the array to contain one empty string ReDim strFrom(0) End If End Sub