'* Изначально взято с http://www.spss.com/tech/answer/result.cfm?tech_tan_id=100009245 '-----------------сохраните всё, что ниже, как ReverseAutoRecode10.sbs ------------------------- 'Begin Description 'Данный скрипт работает подобно команде SPSS AUTORECODE (автоперекодирование), но в "обратном" направлении: 'скрипт создаёт новую СТРОКОВУЮ переменную, чьи значения являются метками исходной переменной. 'Это, например, даёт возможность экспортировать файл в другое приложение, сохранив метки. 'Если в открытом редакторе данных нет переменных, либо переменных с метками значений, скрипт информирует об этом пользователя. 'Если перед запуском скрипта пользователь выделил переменную в редакторе данных, в диалоге такая переменная 'оказывается выделенной по умолчанию. 'Если вы хотите локализовать этот скрипт, просто замените содержимое объявленных ниже констант. ' :) - примеч. перев. 'End Description 'Автор: Bernhard Witt, представительство SPSS в Германии ' Перевод: А. Балабанов, 15.11.2008 ' Проверено: SPSS 15.0.1.1, есть одно исправление: см. комментарий со значками ###. 'Текстовые константы для взаимодействия с пользователем 'Русскоязычные выражения 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 = "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)" 'Выражения на немецком языке '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 '######################################################################### 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 strOldVar = Variablenliste$(Varnummer) strRecode = BuildRecode(objDataDoc, lngVarNum, strOldVar, Varneu) strCommands = strCommands & strRecode & vbCrLf & "Execute ." Label2String = strCommands End Function '######################################################################### 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,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 ' Инициализация 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 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 Function BuildRecode(objDataDoc As ISpssDataDoc, lngVar As Long, _ strOldName As String, strNewName As String) As String ' Объявление переменных для хранения информации о метках значений. Dim numValueLabels As Long Dim vntValueLabelCounts As Variant Dim vntValueLabels As Variant Dim strRecode As String Dim MaxLabelLength As Integer Dim LabelLength As Integer ' Для каждой переменной получим число меток значений и сами метки. numValueLabels = objDataDoc.GetVariableValueLabels (lngVar, _ vntValues, vntValueLabels) ' Для отладки: распечатаем информацию о метках. Debug.Print "Переменная: " & lngVar & vbTab & "Метки: " & numValueLabels ' Цикл по меткам, печатаем значение и метку. Dim i As Long ' при необходимости ставим кавычки вокруг строковых значений 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) ' Цикл по массиву, добавление кавычек к строковым значениям. Dim i As Long If VarType(vntArray) = (vbString + vbArray) Then Debug.Print "Добавление кавычек к строковым значениям:" 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