Reverse autorecode

'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 = "Label2String"
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)"


'German expressions
'Const TextNoVariables = "Es sind keine Variablen vorhanden."
'Const TextNoVarWithLabels = "Es sind keine Variablen mit Wertelabels vorhanden!"
'Const TextTargetAlreadyExist = "Die Zielvariable ist bereits vorhanden. Bitte geben Sie eine andere Variable an."
'Const TextPleaseEnterTarget = "Bitte geben Sie eine Zielvariable ein."
'Const TextWarning = "Achtung"
'Const TextDialogBoxTitle = "Label2String"
'Const TextDialogBoxVariable = "Variable"
'Const TextDialogBoxTarget = "Zielvariable"
'Const TextDialogBoxSource = "Ausgangsvariable"
'Const TextDialogBoxHelp = "Hilfe"
'Const TextHelpText = "Label2String erstellt eine neue Variable, in der die Labels der" + Chr$(13)+ "Ausgangsvariable als String verwendet werden."+Chr$(13) + "(Label2String ist somit das Gegenteil von Autorecode)"+Chr$(13)+Chr$(13)+ "(c) 1997 by SPSS Germany - Autor: Bernhard Witt"
'Const TextHelpTextHead = "Hilfe zu Label2String"
'Const TextTargetTooLong = "Die Zielvariable ist lдnger als 8 Zeichen"

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


'#########################################################################
Sub Label2String (Varnummer, Varneu$)
'#########################################################################
Dim objSpssApp As Object
Dim strCommands As String
Set objSpssApp = CreateObject("SPSS.Application")

Set objDocuments=objSpssApp.Documents
Set objDataDoc = objDocuments.GetDataDoc(0)

NumCases = objDataDoc.GetNumberOfCases
Original = objDataDoc.GetTextData (Variablenliste$(Varnummer), Variablenliste$(Varnummer), 1, NumCases)

'How long is the longest Label of the current variable?
MaxLabelLength = 0
For count = 0 To NumCases-1
	AktLabel = Original (0,count)
	If Len(AktLabel) > MaxLabelLength Then
		MaxLabelLength = Len(AktLabel)
	End If
Next

'create the new variable
strCommands = "string "+Varneu$+"(A"+LTrim$(Str$(MaxLabelLength))+")." & vbCr
strCommands = strCommands & "execute." & vbCr
objSpssApp.ExecuteCommands strCommands, False
While objSpssApp.IsBusy
	'wait until spss processor is ready
Wend

Original = objDataDoc.GetTextData (Variablenliste$(Varnummer), Variablenliste$(Varnummer), 1, NumCases)
For count = 0 To NumCases-1
	objDataDoc.SelectCells (VarNeu$, VarNeu$, count+1, count+1)
	While objSpssApp.IsBusy
		'wait until spss processor is ready
	Wend
	Clipboard Original (0,count)
	While objSpssApp.IsBusy
		'wait until spss processor is ready
	Wend
	objDataDoc.Paste
	While objSpssApp.IsBusy
		'wait until spss processor is ready
	Wend
Next


End Sub


'#########################################################################
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,14,70,21
		PushButton 360,91,70,21,TextDialogBoxHelp,.Hilfe
		CancelButton 360,42,70,21,.Abbrechen
	End Dialog

Dim dlg As UserDialog
dlg.ListBox1 = selectedVariable
erg=Dialog (dlg)
If erg = -1 Then
Call Label2String (dlg.ListBox1,dlg.Varneu)
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
Dim spss As Object
Set spss=CreateObject("SPSS.application")
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


---------------------------------------------------------------------------