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
|