'begin description
'Назначение: переписать метки всех переменных и их значений в рабочем файле данных прописными буквами
'Условия: редактор данных содержит открытый файл данных,
' папка "c:\\temp" существует.
'Примеч.: пустые метки переменных остаются пустыми.
'end description
'Размещено в SPSSX-L 21.12.2002, автор: Raynald Levesque
'Сайт по SPSS: http://www.spsstools.ru
' Перевод: А. Балабанов, 14.11.2008.
' Проверено: SPSS 15.0.0.
Sub Main
' Объявление переменных скрипта и получение доступа к объекту SpssInfo:
Dim objSpssInfo As ISpssInfo
Dim strVarName As String, lngLength As Long
Dim strList ( ) As String
Set objSpssInfo = objSpssApp.SpssInfo
Open "C:\\temp\\labels.sps" For Output As #1
' Подсчёт количества переменных и их обработка:
Dim varCount As Integer, I As Integer
With objSpssInfo
varCount = .NumVariables
For I = 0 To varCount - 1
strVarName = .VariableAt(I)
' Вывод в файл метки переменной
Print #1, "VARIABLE LABEL " & strVarName & " '" & UCase(.VariableLabelAt(I)) & "'."
' Вывод в файл меток значений
Dim valCount As Integer, J As Integer
valCount=.NumberOfValueLabels(I)
If valCount > 0 Then
ReDim strList (2, valCount) 'Объявление размера массива для списка меток значений
Print #1,"ADD VALUE LABEL " & strVarName
If .VarType(I) = SpssDataString Then
For J = 0 To valCount-1
Print #1," '" & .ValueAt(I, J) & "' '" & UCase(.ValueLabelAt (I, J)) & "'"
Next
Else
For J = 0 To valCount-1
Print #1," " & .ValueAt(I, J) & " '" & UCase(.ValueLabelAt (I, J)) & "'"
Next
End If
Print #1,"."
End If
Next I
End With
Close #1
objSpssApp.ExecuteInclude ("c:\\temp\\labels.sps",False)
Set objSpssInfo = Nothing
End Sub