«Обратный» AUTORECODE

'Begin Description
'Данный скрипт работает подобно команде SPSS AUTORECODE (автоперекодирование), но в "обратном" направлении:
'скрипт создаёт новую СТРОКОВУЮ переменную, чьи значения являются метками исходной переменной.
'Это, например, даёт возможность экспортировать файл в другое приложение, сохранив метки.
'Если в открытом редакторе данных нет переменных, либо переменных с метками значений, скрипт информирует об этом пользователя.
'Если перед запуском скрипта пользователь выделил переменную в редакторе данных, в диалоге такая переменная
'оказывается выделенной по умолчанию.

'Если вы хотите локализовать этот скрипт, просто замените содержимое объявленных ниже констант.
' :) - примеч. перев.

'End Description

'Автор: Bernhard Witt, представительство SPSS в Германии

' Перевод: А. Балабанов, 15.11.2008
' Проверено: SPSS 15.0.1.1. Вероятно, в версиях, после 9.0 скрипт оказывается неработоспособным:
' 1) из-за создания нового объекта SPSS,
' 2) из-за особенностей работы функции .GetTextData в позднейших версиях SPSS
' 3) из-за специфики формирования некоторых индексов, а также строк команд для запуска синтаксиса.
' Скрипт был видоизменён мной (А.Б.) для работоспособности, см. комментарии со значками ###.
' В версиях 14 и далее можно найти более эффективный способ решения данной задачи. Один из вариантов: использование функции СИНТАКСИСА ValueLabel:
' COMPUTE yyy=ValueLabel(xxx). - примеч. перев.
' Также в файле http://www.spsstools.ru/Scripts/Labels/ReverseAutoRecode10.txt можно найти видоизменённую версию этого скрипта самим автором
' (для версий SPSS 10+).

'Текстовые константы для взаимодействия с пользователем
'Русскоязычные выражения
Const TextNoVariables = "В редакторе данных отсутствуют переменные."
Const TextNoVarWithLabels = "Отсутствуют переменные с метками значений!"
Const TextTargetAlreadyExist = "Результирующая переменная уже существует. Пожалуйста, укажите другое имя."
Const TextPleaseEnterTarget = "Пожалуйста, укажите имя для результирующей переменной."
Const TextWarning = "Внимание"
Const TextDialogBoxTitle = "Label2String"
Const TextDialogBoxVariable = "Переменная"
Const TextDialogBoxTarget = "Результирующая"
Const TextDialogBoxSource = "Исходная"
Const TextDialogBoxHelp = "Справка"
Const TextHelpText = "Скрипт Label2String создаёт новую строковую переменную, чьими значениями являются" + Chr$(13)+ "метки исходной переменной."+Chr$(13) + Chr$(13)+ "(c) 1997, SPSS Germany - автор: Bernhard Witt"
Const TextHelpTextHead = "Помощь Label2String"
Const TextTargetTooLong = "Имя результирующей переменной слишком длинное (максимум: 8 символов)"

'Англоязычные выражения
'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)"


'Выражения на немецком языке
'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						'Объект диалога с пользователем
Public VarLabel$()				'Массив с метками значений выделенной переменной
Public VarWert()				'Массив со значениями выделенной переменной
Public Variablenliste$()		'Массив, включающий все переменные, имеющие, по крайней мере,
								'одну метку значения
Public AnzLabVariablen			'число помеченных значений выделенной переменной
Public BigVarListe$()			'массив со всеми переменными файла данных
Public BigVarlistedim			'число элементов массива BigVarListe$(), определённого выше
Public selectedVariable			'порядковый номер выделенной переменной в массиве 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)

'Определение максимальной длины метки в текущей переменной
Dim pValues, pLabels, numValLab, strRecode As Variant' ### добавлено
numValLab=objDataDoc.GetVariableValueLabels(Varnummer,pValues,pLabels)' ### добавлено

MaxLabelLength = 0
strRecode=""
For count = 0 To numValLab-1 '### изменено
	AktLabel = pLabels(count)' ### изменено
	strRecode=strRecode & "(" & CStr(pValues(count)) & "= '" & AktLabel & "') " '### добавлено
	If Len(AktLabel) > MaxLabelLength Then
		MaxLabelLength = Len(AktLabel)
	End If
Next

'Создание новой переменной
strCommands = "string "+Varneu$+"(A"+LTrim$(Str$(MaxLabelLength))+"). "&vbCrLf ' ### добавлено Lf
strCommands = strCommands & "execute."
objSpssApp.ExecuteCommands strCommands, False
While objSpssApp.IsBusy
	'Ожидание готовности SPSS-процессора
Wend

objSpssApp.ExecuteCommands "RECODE " & Variablenliste$(Varnummer) & strRecode & "INTO " & Varneu$, True '### добавлено
objSpssApp.ExecuteCommands "EXE.",True '### добавлено


'### блок кода удален
'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
'		'Ожидание готовности SPSS-процессора
'	Wend
'	Clipboard Original (0,count)
'	While objSpssApp.IsBusy
'		'Ожидание готовности SPSS-процессора
'	Wend
'	objDataDoc.Paste
'	While objSpssApp.IsBusy
'		'Ожидание готовности SPSS-процессора
'	Wend
'Next
'### конец удаленного блока

End Sub


'#########################################################################
Sub myDialog
'Создание диалогового окна
'#########################################################################
	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	' Инициализация
Case 2	' Активирован элемент управления диалога
	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
			'Проверка, не существует ли уже переменной с именем, определённым пользователем для результирующей переменной.
			'Если так, сообщаем об этом и не покидаем диалог
			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	' Изменилось текстовое поле

Case 4	' Сменился фокус

Case 5	' Ничего (не делаем)

Case Else

End Select

End Function


'#########################################################################
Sub GetVariablenliste
'Создаёт список всех переменных, имеющих метки значений
'#########################################################################

Dim objSpssInfo As ISpssInfo
Dim strVarName As String, strLabel As String
'Dim spss As Object '###
'Set spss=CreateObject("SPSS.application") '###
Set objSpssInfo=objSpssApp.SpssInfo

'Определение выбранной пользователем в редакторе данных переменной, если такая есть
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
	'подсчёт числа переменных, которые используют, по крайней мере, одну метку значения и
	'сохранение списка имён таких переменных
	AnzLabVariablen = 0

	ReDim BigVarListe$(AnzVariablen-1)
	BigVarlistedim = AnzVariablen-1
	
	'подсчёт число переменных, имеющих не менее одной метки значения
	For count = 0 To AnzVariablen-1
		BigVarListe$(count) = objSpssInfo.VariableAt(count)
		If objSpssInfo.NumberOfValueLabels(count) >0 Then
			AnzLabVariablen = AnzLabVariablen +1
		End If
	Next

	'Если есть хотя бы одно переменная с метками значений, строим массив имён таких переменных
	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 count=Selektiert-1 Then ' ### добавлено -1
					selectedVariable = mycount
				End If
				mycount = mycount+1
			End If
		Next
	End If
Else
	MsgBox TextNoVariables,64,TextWarning
End If

End Sub