Sub Main
Dim T,T2,T1,T3,T4,T5,T6,T7
Dim A,B,C,D,E,X,Y,R
Dim N1,N2,N3,N4,N5,N6,N7,N8,N9,N10
Dim A2,B2,C2,D2
Dim S1,S2,S3
'
'
rs = InputBox("Quante estrazioni vuoi controllare?",,0)
k = 0
For es = EstrazioneFin - rs To EstrazioneFin
AvanzamentoElab EstrazioneFin - rs,EstrazioneFin,es
For R = 1 To 10
'
A = Estratto(es,R,1)
B = Estratto(es,R,2)
C = Estratto(es,R,3)
D = Estratto(es,R,4)
E = Estratto(es,R,5)
'
'---------------------------------
ReDim MatriceCaselleDaEvid(5,1)
'
MatriceCaselleDaEvid(1,0) = R
MatriceCaselleDaEvid(1,1) = 1
'
MatriceCaselleDaEvid(2,0) = R
MatriceCaselleDaEvid(2,1) = 2
'
MatriceCaselleDaEvid(3,0) = R
MatriceCaselleDaEvid(3,1) = 3
'
MatriceCaselleDaEvid(4,0) = R
MatriceCaselleDaEvid(4,1) = 4
'
MatriceCaselleDaEvid(5,0) = R
MatriceCaselleDaEvid(5,1) = 5
Call DisegnaEstrazione(es,MatriceCaselleDaEvid)
'
T1 = Array(T1," "," "," "," "," "," "," "," ")
'Call InitTabella(T1)
'-------------------------------
'-------------------------------
T1 = Array(T1,Format2(A)," ",Format2(B)," ",Format2(C)," ",Format2(D)," ",Format2(E))
Call InitTabella(T1)
Call SetColoreCella(1,RGB(0,0,255),RGB(255,255,255))
Call SetColoreCella(3,RGB(0,0,255),RGB(255,255,255))
Call SetColoreCella(5,RGB(0,0,255),RGB(255,255,255))
Call SetColoreCella(7,RGB(0,0,255),RGB(255,255,255))
Call SetColoreCella(9,RGB(0,0,255),RGB(255,255,255))
'-------------------------------
'---------
N1 = Abs(A - B)
N2 = Abs(B - C)
N3 = Abs(C - D)
N4 = Abs(D - E)
'---------------------------------
If A < B And B > C And C < D And D > E Then
T2 = Array(T2," ",("+" & N1)," ",("-" & N2)," ",("+" & N3)," ",("-" & N4)," ")
Call AddRigaTabella(T2)
Call SetColoreCella(2,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(4,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(6,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(8,RGB(255,255,255),RGB(0,0,0))
Else
If A > B And B < C And C > D And D < E Then
T2 = Array(T2," ",("-" & N1)," ",("+" & N2)," ",("-" & N3)," ",("+" & N4)," ")
Call AddRigaTabella(T2)
Call SetColoreCella(2,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(4,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(6,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(8,RGB(255,255,255),RGB(0,0,0))
End If
End If
'--------------------------------
'-------------------------------
'---------
'---------------------------------
If A > C Then N5 =(A - C) : N5 =("-") & N5 Else If A < C Then N5 = Fuori90(90 - A + C) : N5 =("+") & N5
If B > D Then N6 =(B - D) : N6 =("-") & N6 Else If B < D Then N6 = Fuori90(90 - B + D) : N6 =("+") & N6
If C > E Then N7 =(C - E) : N7 =("-") & N7 Else If C < E Then N7 = Fuori90(90 - C + E) : N7 =("+") & N7
'-----------------------------------------
T3 = Array(T3," "," ",(N5)," ",(N6)," ",(N7)," "," ")
Call AddRigaTabella(T3)
Call SetColoreCella(3,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(5,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(7,RGB(255,255,255),RGB(0,0,0))
'--------------------------------
'---------------------------------------------------------------------
'--------------------------------
'
If A > D Then N8 =(A - D) : N8 =("-") & N8 Else If A < D Then N8 = Fuori90(90 - A + D) : N8 =("+") & N8
If B > E Then N9 =(B - E) : N9 =("-") & N9 Else If B < E Then N9 = Fuori90(90 - B + E) : N9 =("+") & N9
'---------
'---------------------------------
T4 = Array(T4," "," "," ",(N8)," ",(N9)," "," "," ")
Call AddRigaTabella(T4)
Call SetColoreCella(4,RGB(255,255,255),RGB(0,0,0))
Call SetColoreCella(6,RGB(255,255,255),RGB(0,0,0))
'--------------------------------
If A > E Then N10 =(A - E) : N10 =("-") & N10 Else If A < E Then N10 = Fuori90(90 - A + E) : N10 =("+") & N10
'---------------------------------
T5 = Array(T5," "," "," "," ",(N10)," "," "," "," ")
Call AddRigaTabella(T5)
Call SetColoreCella(5,RGB(255,255,255),RGB(0,0,0))
'--------------------------------
'--------------------------------
'
'---------------------------------
T6 = Array(T6," "," "," "," "," "," "," "," "," ")
Call AddRigaTabella(T6)
Call SetColoreCella(5,RGB(255,255,255),RGB(0,0,0))
'--------------------------------
Call SetTableWidth("19%")
CreaTabella
Next
Next
End Sub