Scripts error: Subscript is out of bounds

[Max Bell-2]

> Hello everybody,
>
> I get an error when I run a script an a long table (Error is ...
> Subscript is out of bounds)
>
> It might have got something to do with the declaration of variables
> (Dim ...), but I can't figure it out. When the table is shorter (say 5
> rows) it works fine, but on a long table (30 rows) there is the error.
>
> The script is printed below. The script is run via syntax:
>
> script 'P:\Scripts\VerkeerslichtSPECIFICcolumns.SBS'
> ('6.5;8.5;1;0;1;1;5').
>
> (the script applies colours to low, middle and high values in
> specified columns; the parameters in this case are:
> 6.5: low value
> 8.5: high value
> 1: apply colour on values lower than low value
> 0: do not apply colour on mid value
> 1: apply colour on values higher than high value
> 1;5: apply the colours on data columns 1 to 5).
>
>
> I would very much appreciate anybody's help.
> Thanks in advance,
> Max
>
>

*******script******
Option Explicit


Sub Main


        Dim objPivotTable As PivotTable
        Dim objItem As ISpssItem
        Dim bolFoundOutputDoc As Boolean
        Dim bolPivotSelected As Boolean
        Dim lngRowNum As Long
       
        'The following procedure is a global procedure that is located
in Global.sbs
        Call GetFirstSelectedPivot(objPivotTable, objItem,
bolFoundOutputDoc,bolPivotSelected)
        If (bolFoundOutputDoc = False) Or (bolPivotSelected = False)
Then
        'either there wasn't an output doc or a pivot table wasn't
selected
                Exit Sub
        End If
        Call LeesDataCellenVanTabeluit(objPivotTable)
        objItem.Deactivate
End Sub


Sub LeesDataCellenVanTabeluit(objPivotTable As PivotTable)
        Dim objDataCells As ISpssDataCells
        Dim i As Long
            Dim j As Long
        Dim pars As String
        Dim k As Integer
        Dim low As Variant
        Dim high As Variant
        Dim c1 As Variant
        Dim c2 As Variant
        Dim clow As Integer
        Dim cmid As Integer
        Dim chigh As Integer

        Const collow = RGB(255,0,0) 'rood
        Const colmid =  RGB(255,255,0) 'geel
        Const colhigh = QBColor(3) 'soort groen (cyan)

        pars = objSpssApp.ScriptParameter(0)
        ' pars = "2.5;3.0;1;0;1;6;6"

        low = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(low)

        high = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(high)

        clow = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(clow)

        cmid = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(cmid)

        chigh = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(chigh)

        c1 = Val(Left(pars, InStr(pars,";")-1))-1
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(c1)

        c2 = Val(pars)-1
        'MsgBox CStr(c2)

        Set objDataCells = objPivotTable.DataCellArray
       
    For i = 0 To objDataCells.NumRows - 1
        For k  = c1 To c2
                If Not IsNull (objDataCells.ValueAt(i, k)) Then
                If  (Val(Replace$((objDataCells.ValueAt(i,
k)),",","."))>= high And chigh=1)  Then
                                        objDataCells.TextColorAt (i, k)
=  colhigh
       
objDataCells.TextStyleAt(i,k)=SpssTSBold
                            ElseIf
(Val(Replace$((objDataCells.ValueAt(i, k)),",",".")) > low And
Val(Replace$((objDataCells.ValueAt(i, k)),",",".")) < high And cmid=1)
Then
                                objDataCells.TextColorAt (i, k) =
colmid
                                objDataCells.TextStyleAt(i,k)=SpssTSBold
                            ElseIf
(Val(Replace$((objDataCells.ValueAt(i, k)),",",".")) <= low And clow=1)
Then
                                objDataCells.TextColorAt (i, k) =
collow
                                objDataCells.TextStyleAt(i,k)=SpssTSBold
                            End If
            End If
        Next k
    Next i
 

End Sub
*******script******

====================To manage your subscription to SPSSX-L, send a message to
[hidden email] (not to SPSSX-L), with no body text except the
command. To leave the list, send the command
SIGNOFF SPSSX-L
For a list of commands to manage subscriptions, send the command
INFO REFCARD

[Boer, CPJ de]

Hi Max,

At what line does the out of bounds error occur??

For what it's worth: Does it make any difference if you declare k, c1, c2, clow, chigh and cmid in function LeesDataCellenVanTabeluit to be long in stead of integer.
And i don't know at what index tables start of in SPSS-basic, if it starts at index 1 the asking element number 0 is 'out of bound(ary)'...
There might be an 'Option index = 0' or something like that to put at the beginning of the script.

Greetings,

Kees de Boer
________________________________
Ing. C.P.J. (Kees) de Boer
EMGO, VUmc
Datamanagement & Systeembeheer
D-451 tel. [phone]

"Geloof: Geloven zonder bewijs in wat iemand die spreekt zonder kennis heeft gezegd over zaken die onvergelijkbaar zijn." Ambrose Bierce



-----Oorspronkelijk bericht-----
Van: SPSSX(r) Discussion [mailto:[hidden email]]Namens Max
Bell
Verzonden: woensdag 31 oktober 2007 11:30
Aan: [hidden email]
Onderwerp: Scripts error: Subscript is out of bounds

> Hello everybody,
>
> I get an error when I run a script an a long table (Error is ...
> Subscript is out of bounds)
>
> It might have got something to do with the declaration of variables
> (Dim ...), but I can't figure it out. When the table is shorter (say 5
> rows) it works fine, but on a long table (30 rows) there is the error.
>
> The script is printed below. The script is run via syntax:
>
> script 'P:\Scripts\VerkeerslichtSPECIFICcolumns.SBS'
> ('6.5;8.5;1;0;1;1;5').
>
> (the script applies colours to low, middle and high values in
> specified columns; the parameters in this case are:
> 6.5: low value
> 8.5: high value
> 1: apply colour on values lower than low value
> 0: do not apply colour on mid value
> 1: apply colour on values higher than high value
> 1;5: apply the colours on data columns 1 to 5).
>
>
> I would very much appreciate anybody's help.
> Thanks in advance,
> Max
>
>

*******script******
Option Explicit


Sub Main


        Dim objPivotTable As PivotTable
        Dim objItem As ISpssItem
        Dim bolFoundOutputDoc As Boolean
        Dim bolPivotSelected As Boolean
        Dim lngRowNum As Long

        'The following procedure is a global procedure that is located
in Global.sbs
        Call GetFirstSelectedPivot(objPivotTable, objItem,
bolFoundOutputDoc,bolPivotSelected)
        If (bolFoundOutputDoc = False) Or (bolPivotSelected = False)
Then
        'either there wasn't an output doc or a pivot table wasn't
selected
                Exit Sub
        End If
        Call LeesDataCellenVanTabeluit(objPivotTable)
        objItem.Deactivate
End Sub


Sub LeesDataCellenVanTabeluit(objPivotTable As PivotTable)
        Dim objDataCells As ISpssDataCells
        Dim i As Long
        Dim j As Long
        Dim pars As String
        Dim k As Integer
        Dim low As Variant
        Dim high As Variant
        Dim c1 As Variant
        Dim c2 As Variant
        Dim clow As Integer
        Dim cmid As Integer
        Dim chigh As Integer

        Const collow = RGB(255,0,0) 'rood
        Const colmid =  RGB(255,255,0) 'geel
        Const colhigh = QBColor(3) 'soort groen (cyan)

        pars = objSpssApp.ScriptParameter(0)
        ' pars = "2.5;3.0;1;0;1;6;6"

        low = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(low)

        high = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(high)

        clow = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(clow)

        cmid = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(cmid)

        chigh = Val(Left(pars, InStr(pars,";")-1))
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(chigh)

        c1 = Val(Left(pars, InStr(pars,";")-1))-1
        pars = Right(pars,Len(pars)- InStr(pars,";"))
        'MsgBox CStr(c1)

        c2 = Val(pars)-1
        'MsgBox CStr(c2)

        Set objDataCells = objPivotTable.DataCellArray

    For i = 0 To objDataCells.NumRows - 1
        For k  = c1 To c2
                If Not IsNull (objDataCells.ValueAt(i, k)) Then
                If  (Val(Replace$((objDataCells.ValueAt(i,
k)),",","."))>= high And chigh=1)  Then
                                        objDataCells.TextColorAt (i, k)
=  colhigh

objDataCells.TextStyleAt(i,k)=SpssTSBold
                            ElseIf
(Val(Replace$((objDataCells.ValueAt(i, k)),",",".")) > low And
Val(Replace$((objDataCells.ValueAt(i, k)),",",".")) < high And cmid=1)
Then
                                objDataCells.TextColorAt (i, k) =
colmid
                                objDataCells.TextStyleAt(i,k)=SpssTSBold
                            ElseIf
(Val(Replace$((objDataCells.ValueAt(i, k)),",",".")) <= low And clow=1)
Then
                                objDataCells.TextColorAt (i, k) =
collow
                                objDataCells.TextStyleAt(i,k)=SpssTSBold
                            End If
            End If
        Next k
    Next i


End Sub
*******script******

=======
To manage your subscription to SPSSX-L, send a message to
[hidden email] (not to SPSSX-L), with no body text except the
command. To leave the list, send the command
SIGNOFF SPSSX-L
For a list of commands to manage subscriptions, send the command
INFO REFCARD

=====================
To manage your subscription to SPSSX-L, send a message to
[hidden email] (not to SPSSX-L), with no body text except the
command. To leave the list, send the command
SIGNOFF SPSSX-L
For a list of commands to manage subscriptions, send the command
INFO REFCARD