'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. 'It differs from VarListDemo2 only in that it uses a function call and 'static variables, to avoid the use of global variables. 'This simplifies encapsulation of the code, and encourages reuse, but is 'otherwise unneeded. 'End Description 'require variables to be dimensioned before use Option Explicit 'demonstrates use of the MultipleVariableSelectionDialog function Sub Main 'we'll call a function which returns variables selected 'by the user in an array of strings we pass it. Dim strVarsSelected() As String '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 - which we only allow after at least one 'variable is selected. 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 'but we have to pass it a string array or there will be a type mismatch. Dim strVariables() As String ReDim strVariables(0) 're-initialize the Selected array, to make sure it isn't empty. 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 CancelButton 220,161,110,21 PushButton 210,35,80,21," Add >> ",.PushButtonAdd 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 'this actually puts up the dialog. Dialog dlg 'we used a utility function called from the dialog monitor 'to store the variables. Request them now. strVarsSelected() = SelectedVariableArray("", False) 'return true since user hit OK MultipleVariableSelectionDialog = True 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 ReDim strVarsSelected(0) 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 'the item selected Dim intDlgItem As Integer Select Case Action% Case 1 ' Dialog box initialization 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) 'while initializing, return True to close the dialog '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 'store the array, ignore the function result Call SelectedVariableArray(strVarsSelected(), True) 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, intItem will be valid 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 strTo(intUpper); intUpper; intItem 'make the array larger, but 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 item down one position 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 'this is a cheap dodge which lets us avoid using a global variable 'to pass the array out of the dialog monitor. This function stores 'its parameter when called with blnStore = True, and returns whatever 'was stored previously as the function result. This makes it easier 'to encapsulate code, since when copying the code for re-use, we 'don't need to create and follow instructions to add a global variable 'to the project in order for the code to work. Function SelectedVariableArray(vntStore As Variant, blnStore As Boolean) As Variant Static vntStored As Variant SelectedVariableArray = vntStored 'we refuse to store anything but an array of strings If blnStore Then If IsArray(vntStore) Then If VarType(vntStore(0)) = vbString Then vntStored = vntStore End If End If End If End Function