1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
'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