'Begin Description 'Purpose: To assign value labels of format mmm yyyy (eg Feb 1997) to a numeric variable 'Assumptions: The numeric variable is in the data editor and contains positive integers 'Inputs: 5 parameters are required, 1) varname, 2)starting month, 3)starting year, 4)direction (1 means ' forward and -1 means backward) and 5)number of years. ' ' If you want to run the script by itself (i.e. NOT call it from a syntax file), ' a line of the following form is used in the Main Sub of this script ' strParam="month,1,1990,-1,10" ' ' If you want to call the script from a syntax file, a line of the following type is ' used in the syntax file: ' SCRIPT file="c:\\program files\\spss\\scripts\\AddValueLabels.sbs" ("month,7,1998,-1,10"). ' 'Return Values: none 'Author: Raynald Levesque rlevesque@videotron.ca 'Date: April 24, 1999 'End Description 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 'Error handler StrErr = "Following error occured:" On Error GoTo ErrLoad strParam = objSpssApp.ScriptParameter(0) 'Uncomment next line if Script is not called from syntax, modify the 5 parameters to suit your needs. 'strParam="trial,2,1992,-1,5" ParseInput(strParam) StrErr = "Error while validating input string:" 'Validate input values (future improvement: could verify that strVarName exists) If Len(strVarName)>8 Then Err.Raise Number:=1, Description:="Invalid Variable Name" If intMoNumber>12 Or intMoNumber<1 Then Err.Raise Number:=1, Description:="Invalid Initial month!" If intDelta<>1 And intDelta<>-1 Then Err.Raise Number:=1, Description:="4th parameter must be 1 or -1!" If intNumberYears<1 Or intYear<1 Then Err.Raise Number:=1, Description:="3rd and 5th parameters must be positive integers!" AssignLabels Exit Sub ErrLoad: MsgBox StrErr & vbCr & Err.Description, vbExclamation, "Error " & Err 'display warning for the user Debug.Print StrErr & vbCr & "Error " & Err 'for the record Exit Sub End Sub Sub AssignLabels 'Asign Labels StrErr = "Error while assigning Labels:" Dim strCommand As String, strMoNames(12) As String, intCount As Integer Dim intCountYear As Integer, intMonth As Integer strMoNames(1)="Jan" strMoNames(2)="Feb" strMoNames(3)="Mar" strMoNames(4)="Apr" strMoNames(5)="May" strMoNames(6)="Jun" strMoNames(7)="Jul" strMoNames(8)="Aug" strMoNames(9)="Sep" strMoNames(10)="Oct" strMoNames(11)="Nov" strMoNames(12)="Dec" 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 'Check if we are crossing a year If intMoNumber > 12 And intDelta >0 Then 'need to go to Jan of following year IntMoNumber=1 intYear= intYear + intDelta ElseIf intMoNumber < 1 And intDelta <0 Then 'need to go to Dec of preceeding year 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) ' Parse the input string into its 5 components Dim intTemp1 As Integer, intTemp2 As Integer, strValue As String StrErr = "Error while parsing input:" 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