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
'Begin Description
'Назначение: приписать метки значений вида mmm yyyy (например, фев 1997) числовой переменной
'Условия: числовая переменная находится в редакторе данных и имеет в качестве значений положительные целые числа
'Входные параметры: требуется 5 параметров: 1) имя переменной, 2) начальный месяц, 3) начальный год, 4) направление времени (1 - прямое,
'		-1 - обратное) и 5) число лет.
'		
'		Если вы хотите вызывать скрипт сам по себе, т.е. не из синтаксиса,
'		параметры следует указывать в процедуре Main в строке следующего вида (например):
'		strParam="month,1,1990,-1,10"
'		
'		Если вы хотите вызывать скрипт из синтаксиса, параметры следует передавать в следующей
'		инструкции синтаксиса (например):
'		SCRIPT file="c:\\program files\\spss\\scripts\\AddValueLabels.sbs" ("month,7,1998,-1,10").
'				
'Выходные значения: нет
'Автор: Raynald Levesque, rlevesque@videotron.ca
'Дата: 24 апреля 1999 г.
'End Description

' Перевод: А. Балабанов, 14.11.2008.

Option Explicit
Public strParam As String, intMoNumber As Integer, intYear As Variant, intDelta As Integer
Public strVarName As String, intNumberYears As Integer, StrErr As String

Sub Main
	'Обработчик ошибок
	StrErr = "Произошла ошибка: "
	On Error GoTo ErrLoad

	strParam = objSpssApp.ScriptParameter(0)
	
	'Снимите комментарий со следующей строки, если скрипт вызывается не через синтаксис; поправьте 5 входных параметров под свои нужды.
	'strParam="trial,2,1992,-1,5"
	ParseInput(strParam)
	StrErr = "Ошибка обработки строки входных параметров: "
	
	'Проверка допустимости значений входных параметров (на будущее: можно сделать проверку присутствия переменной strVarName в файле)
	If Len(strVarName)>8 Then Err.Raise Number:=1, Description:="Неверное имя переменной (стоит старое ограничение на 8 символов)"
	If intMoNumber>12 Or intMoNumber<1 Then Err.Raise Number:=1, Description:="Неверное значения начального месяца!"
	If intDelta<>1 And intDelta<>-1 Then Err.Raise Number:=1, Description:="Четвёртый параметр должен быть либо 1, либо -1!"
	If intNumberYears<1 Or intYear<1 Then Err.Raise Number:=1, Description:="Третий и пятый параметры должны быть положительными целыми числами!"
	
	AssignLabels
	Exit Sub
	
	ErrLoad:
	MsgBox StrErr & vbCr & Err.Description, vbExclamation, "Error " & Err
		'отображение сообщения об ошибке на экран
	Debug.Print StrErr & vbCr & "Ошибка " & Err
		'для целей отладки
	Exit Sub
End Sub


Sub AssignLabels
'Процедура назначения меток
StrErr = "Ошибка при назначении меток: "

	Dim strCommand As String, strMoNames(12) As String, intCount As Integer
	Dim intCountYear As Integer, intMonth As Integer
	
		strMoNames(1)="янв"
		strMoNames(2)="фев"
		strMoNames(3)="мар"
		strMoNames(4)="апр"
		strMoNames(5)="май"
		strMoNames(6)="июн"
		strMoNames(7)="июл"
		strMoNames(8)="авг"
		strMoNames(9)="сен"
		strMoNames(10)="окт"
		strMoNames(11)="ноя"
		strMoNames(12)="дек"
	
	strCommand = "VALUE LABELS " &strVarName &" 1 " & Chr$(34)& strMoNames(intMoNumber) & " " & intYear& Chr$(34) & " "
	intCount = 2
	intMoNumber = intMoNumber + intDelta
	
	For intCountYear=1 To intNumberYears
		For intMonth=1 To 12
			'Проверка перехода в следующий (предыдущий) год
			If intMoNumber > 12 And intDelta >0 Then 		
				'надо начинать с января следующего года
				IntMoNumber=1
				intYear= intYear + intDelta
			ElseIf intMoNumber < 1 And intDelta <0 Then		
				'надо переходить в декабрь предыдущего года
				IntMoNumber= 12
				intYear= intYear + intDelta
			End If

			strCommand = strCommand & intCount & " " & Chr$(34)& strMoNames(intMoNumber) & " " & intYear & Chr$(34) & " "
			intCount=intCount+1
			intMoNumber=intMoNumber + intDelta
		Next intMonth
	Next intCountYear
	strCommand = strCommand & "."
	objSpssApp.ExecuteCommands strCommand, False

End Sub


Sub ParseInput(strInput As String)
' Разложение строки входных параметров на 5 компонентов по переменным скрипта
Dim intTemp1 As Integer, intTemp2 As Integer, strValue As String
StrErr = "Ошибка разбора строки параметров: "
		
	intTemp1	=InStr(strInput,",")
	strVarName	=Mid(strInput,1,intTemp1-1)
	
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intMoNumber	=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intYear		=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intDelta	=CInt(Mid(strInput,intTemp1+1,intTemp2-intTemp1-1))
	
	intTemp1	=intTemp2
	intTemp2	=InStr(intTemp1+1,strInput,",")
	intNumberYears=CInt(Mid(strInput,intTemp1+1,Len(strInput)-intTemp1))
End Sub