'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