'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