Troubleshooting
Problem
I have a numeric variable with value labels defined in SPSS for Windows. How do I create a new string variable that uses the value labels instead?
Resolving The Problem
'-----------------save As ReverseAutoRecode10.sbs -------------------------
'Begin Description
'This script works like Autorecode, but in the other direction:
'The script generates a new string variable which values are equal
'to the labels of the source variable.
'So someone can export a variable to other applications with saving
'his labels.
'If there are no variables or no variables with labels in the current
'document, a warning appears.
'If a variable is selected while entering this script, the variable is selected
'as default in the dialog box
'If you like to translate the script into other languages, simple change the text
'in the following lines
'End Description
'Author: Bernhard Witt, SPSS Germany
'Constants for Textoutput
'English expressions
Const TextNoVariables = "There are no variables in the document."
Const TextNoVarWithLabels = "There are no variables with value labels!"
Const TextTargetAlreadyExist = "The output variable does already exist. " & _
"Please enter a new variable name."
Const TextPleaseEnterTarget = "Please enter a name for the output variable."
Const TextWarning = "Warning"
Const TextDialogBoxTitle = "Label to String"
Const TextDialogBoxVariable = "Variable"
Const TextDialogBoxTarget = "Output variable"
Const TextDialogBoxSource = "Input variable"
Const TextDialogBoxHelp = "Help"
Const TextHelpText = "Label2String creates a new variable which includes the labels of" + Chr$(13)+ "the input variable as strings."+Chr$(13) + Chr$(13)+ "(c) 1997 by SPSS Germany - Author: Bernhard Witt"
Const TextHelpTextHead = "Help Label2String"
Const TextTargetTooLong = "The Output variable is too long (max. 8 characters)"
Public dlg 'Dialog box
Public VarLabel$() 'Array with the actual Valuelabels of the selected variable
Public VarWert() 'Array with the actual Values of the selected variable
Public Variablenliste$() 'Array with includes all variables with at least one
'value label
Public AnzLabVariablen 'number of valuelabels of the selected variable
Public BigVarliste$() 'Array with a all variables of the document
Public BigVarlistedim 'number of elements in BigVarListe$()
Public selectedVariable 'the number of the selected variable in Variablenliste$()
Sub Main
Call GetVariablenliste
If AnzLabVariablen > 0 Then
Call myDialog
Else
MsgBox TextNoVarWithLabels,64,TextWarning
End If
End Sub
'#########################################################################
Function Label2String (Varnummer, Varneu$) As String
'#########################################################################
Dim strCommands As String
Dim objDataDoc As ISpssDataDoc
Set objDocuments=objSpssApp.Documents
Set objDataDoc = objDocuments.GetDataDoc(0)
Dim i As Integer
Dim strVarName As String
Dim lngVarNum As Long
Dim Variables
strVarName = Variablenliste$(Varnummer)
Variables = objDataDoc.GetVariables(False)
For i = 0 To objDataDoc.GetNumberOfVariables - 1
If Variables(i) = strVarName Then
lngVarNum = i
Exit For
End If
Next
Dim strRecode As String
Dim strOldVar As String
'Dim lngVarNum As Long
'lngVarNum = Varnummer
strOldVar = Variablenliste$(Varnummer)
strRecode = BuildRecode(objDataDoc, lngVarNum, strOldVar, VarNeu)
strCommands = strCommands & strRecode & vbCrLf & "Execute ."
Label2String = strCommands
End Function
'#########################################################################
Sub myDialog
'Creates Dialog Box
'#########################################################################
Begin Dialog UserDialog 450,126,TextDialogBoxTitle,.Maskenfunktion
GroupBox 10,7,320,105,TextDialogBoxVariable,.Variable
TextBox 20,42,110,21,.Varneu
ListBox 160,42,140,63,Variablenliste(),.ListBox1
Text 20,28,150,14,TextDialogBoxTarget,.Text2
Text 160,28,120,14,TextDialogBoxSource,.Text3
OKButton 360,7,70,21
PushButton 360,91,70,21,TextDialogBoxHelp,.Hilfe
CancelButton 360,63,70,21,.Abbrechen
PushButton 360,35,70,21,"Paste",.PasteSyntax
End Dialog
Dim strCommands As String
Dim dlg As UserDialog
dlg.ListBox1 = selectedVariable
erg=Dialog (dlg)
If erg = -1 Then
strCommands = Label2String (dlg.ListBox1,dlg.Varneu)
objSpssApp.ExecuteCommands strCommands, False
End If
If erg = 2 Then
Dim objSyntax As ISpssSyntaxDoc
With objSpssApp.Documents
If .SyntaxDocCount < 1 Then
Set objSyntax = objSpssApp.NewSyntaxDoc
Else
Set objSyntax = objSpssApp.GetDesignatedSyntaxDoc
End If
objSyntax.Text = objSyntax.Text & vbCrLf & _
Label2String(dlg.ListBox1, dlg.Varneu)
objSyntax.Visible = True
End With
End If
End Sub
'#########################################################################
Function Maskenfunktion(SteuerelementBez As String, Aktion As Integer , _
ZusatzWert As Integer ) As Boolean
'#########################################################################
Select Case Aktion
Case 1 ' Init
Case 2 ' A Dialogfield was selected
Select Case SteuerelementBez
Case "OK"
If Len (DlgText$("varneu")) = 0 Then
MsgBox TextPleaseEnterTarget,64,TextWarning
DlgFocus "varneu"
Maskenfunktion=True
End If
If Len (DlgText$("varneu")) > 8 Then
MsgBox TextTargetTooLong,64,TextWarning
DlgFocus "varneu"
Maskenfunktion=True
Else
'Check, if the new variable name is already in use
'if so, then msgbox and do not leave dialog box
Valid=1
For count = 0 To BigVarlistedim
If UCase$(DlgText$("Varneu")) = _
UCase$(BigVarListe$(count)) Then
valid = 0
End If
Next
If valid = 0 Then
MsgBox TextTargetAlreadyExist,64,TextWarning
Maskenfunktion=True
Else
Maskenfunktion=False
End If
End If
Case "Hilfe"
MsgBox TextHelpText, 64, TextHelpTextHead
Maskenfunktion=True
Case Else
Maskenfunktion=False
End Select
Case 3 ' Textfield was changed
Case 4 ' focus has changed
Case 5 ' nothing else to do
Case Else
End Select
End Function
'#########################################################################
Sub GetVariablenliste
'creates a list with all variables, which are using labels
'#########################################################################
Dim objSpssInfo As ISpssInfo
Dim strVarName As String, strLabel As String
Set objSpssInfo=objSpssApp.SpssInfo
'determine the selected variable, if exist
Dim Anfang As Long, Ende As Long
Dim Selektiert As Long
temp = objSpssInfo.GetSelectedVariables (Anfang, Ende)
Selektiert=Anfang
Dim AnzVariablen As Integer, countvar As Integer
AnzVariablen = objSpssInfo.NumVariables
If AnzVariablen > 0 Then
'count the variables, which are using at least one label
'and store all variable names
AnzLabVariablen = 0
ReDim BigVarListe$(AnzVariablen - 1)
BigVarlisteDim = AnzVariablen - 1
'count variables with at least one label
For count = 0 To AnzVariablen-1
BigVarListe$(count) = objSpssInfo.VariableAt(count)
If objSpssInfo.NumberOfValueLabels(count) >0 Then
AnzLabVariablen = AnzLabVariablen + 1
End If
Next
'If ther exist at leas one variable with a label, build the varlist-
If AnzLabVariablen>0 Then
ReDim Variablenliste$(AnzLabVariablen-1)
mycount=0
For count = 0 To AnzVariablen-1
If objSpssInfo.NumberOfValueLabels(count)>0 Then
Variablenliste$(mycount) = objSpssInfo.VariableAt(count)
'If the aktual variable is selected,
'then store the index in
If count=Selektiert Then
selectedVariable = mycount
End If
mycount = mycount+1
End If
Next
End If
Else
MsgBox TextNoVariables,64,TextWarning
End If
End Sub
Function BuildRecode(objDataDoc As ISpssDataDoc, lngVar As Long, _
strOldName As String, strNewName As String) As String
' Declare variables to receive the value label information.
Dim numValueLabels As Long
Dim vntValueLabelCounts As Variant
Dim vntValueLabels As Variant
Dim strRecode As String
Dim MaxLabelLength As Integer
Dim LabelLength As Integer
' For the each variable, get the number of value labels
' and the value label information.
numValueLabels = objDataDoc.GetVariableValueLabels (lngVar, _
vntValues, vntValueLabels)
' Print the number of value labels for the variable.
Debug.Print "Variable: " & lngVar & vbTab & "Labels: " & numValueLabels
' Loop through the number of value labels, printing the value and label.
Dim i As Long
' put quotes around string values if needed
AddQuotes vntValues
AddQuotes vntValueLabels
For i = 0 To numValueLabels - 1
Debug.Print vntValues(i) & ":" & vntValueLabels(i)
LabelLength = Len(vntValueLabels(i))
If MaxLabelLength < LabelLength Then
MaxLabelLength = LabelLength
End If
strRecode = strRecode & " (" & vntValues(i) & "=" & _
vntValueLabels(i) & ")" & vbCrLf
Next
strRecode = "RECODE " & vbCrLf & " " & strOldName & vbCrLf & strRecode
strRecode = strRecode & " INTO " & strNewName & " ."
strRecode = "STRING " & strNewName & "(A"+LTrim$(Str$(MaxLabelLength))+")." _
& vbCrLf & strRecode
BuildRecode = strRecode
End Function
Sub AddQuotes(vntArray As Variant)
' Loop through the array, adding quotes to string values.
Dim i As Long
If VarType(vntArray) = (vbString + vbArray) Then
Debug.Print "Adding quotes to string values:"
Else
Exit Sub
End If
For i = 0 To UBound(vntArray)
If VarType(vntArray(i)) = vbString Then
vntArray(i) = "'" & Trim$(vntArray(i)) & "'"
End If
Debug.Print vntArray(i)
Next
End Sub
Related Information
Historical Number
48963
Was this topic helpful?
Document Information
More support for:
IBM SPSS Statistics
Software version:
Not Applicable
Operating system(s):
Windows
Document number:
420965
Modified date:
16 April 2020
UID
swg21480553