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
'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