Option Explicit
Sub Main
Dim R1,R2 ' ruota 1 , ruota 2 possono pure coincidere
Dim RGioco ' ruota di gioco
Dim PR1,PR2 ' posizione r1 , posizione r2
Dim nColpi ' colpi di gioco
Dim nDaSommareR1,nDaSommareR2 ' eventuali numeri da sommare ai rispettivi num delle due ruote
Dim sTipoOpTra ' tipo operazione tra i 2 num , puo anche essere nessuna operazione
Dim nNumEstr ' numero mensile da cui far partire la formula se 0 tutte le estrazioni
Dim nSorte ' sorte di gioco
Dim sRiepilogo ' riepilogo per la msgbox
ReDim aNumInGioco(2) ' numeri in gioco ' puo essere valorizzato anche solo il primo
Dim n1,n2 ' numeri letti da r1 e r2
Dim idEstr
Dim idGiocata
ReDim aRuote(1)
Dim Inizio,Fine
Dim b
Dim sTesto
Inizio = EstrazioneIni
Fine = EstrazioneFin
R1 = Int(InputBox("Immettere la prima ruota da 1 a 12","Scelta prima ruota",1))
sRiepilogo = "Ruota 1 : " & NomeRuota(R1) & vbCrLf
R2 = Int(InputBox(sRiepilogo & vbCrLf & "Immettere la seconda ruota da 1 a 12","Scelta seconda ruota",2))
sRiepilogo = sRiepilogo & "Ruota 2 : " & NomeRuota(R2) & vbCrLf
PR1 = Int(InputBox(sRiepilogo & vbCrLf & "Immettere la posizione da 1 a 5 per la prima ruota","Scelta posizione prima ruota",3))
sRiepilogo = sRiepilogo & "Pos R1 : " & PR1 & vbCrLf
PR2 = Int(InputBox(sRiepilogo & vbCrLf & "Immettere la posizione da 1 a 5 per la seconda ruota","Scelta posizione seconda ruota",3))
sRiepilogo = sRiepilogo & "Pos R2 : " & PR2 & vbCrLf
nDaSommareR1 = Int(InputBox(sRiepilogo & vbCrLf & "Immettere eventualmente un numero da sommare al numero della prima ruota","Scelta numero somma",0))
sRiepilogo = sRiepilogo & "Somma R1 : " & nDaSommareR1 & vbCrLf
nDaSommareR2 = Int(InputBox(sRiepilogo & vbCrLf & "Immettere eventualmente un numero da sommare al numero della seconda ruota","Scelta numero somma",0))
sRiepilogo = sRiepilogo & "Somma R2 : " & nDaSommareR2 & vbCrLf
nColpi = Int(InputBox(sRiepilogo & vbCrLf & "Immettere i colpi di gioco","Colpi di gioco",13))
sRiepilogo = sRiepilogo & "Colpi : " & nColpi & vbCrLf
'RGioco = Int(InputBox(sRiepilogo & vbCrLf & "Immettere la ruota di gioco da 1 a 12","Scelta ruota di gioco",1))
'sRiepilogo = sRiepilogo & "Ruota G : " & NomeRuota(RGioco) & vbCrLf
sTipoOpTra = InputBox(sRiepilogo & vbCrLf & "Immettere il tipo operazione tra i 2 numeri letti , valori possibili < * / + - > , se non devono essere eseguite operazioni preemre annulla in questo caso si giocano 2 numeri","Scelta TipoOp tra i due numeri","+")
sRiepilogo = sRiepilogo & "Operazione : " & "N1 " & sTipoOpTra & " N2" & vbCrLf
sTesto = "Immettere il numero mensile di estrazione su cui eseguire la formula" & vbCrLf
sTesto = sTesto & "mettere 0 per eseguire la formula su tutte le estrazioni del range" & vbCrLf
sTesto = sTesto & "mettere -1 identificare l'ultima estrazione mensile"
nNumEstr = Int(InputBox(sRiepilogo & vbCrLf & " " & vbCrLf & sTesto,"Scelta num estr mensile",0))
sRiepilogo = sRiepilogo & "NumEstrMens : " & nNumEstr & vbCrLf
nSorte = Int(InputBox(sRiepilogo & vbCrLf & "Immettere la sorte di gioco da 1 a 5" & vbCrLf & "Il range analizzato è quello impostato nel programma dalla barra rosa sotto","Sorte di gioco",1))
sRiepilogo = sRiepilogo & "Sorte : " & nSorte & vbCrLf
'aRuote(1) = RGioco
ReDim aRuote(0)
If ScegliRuote(aRuote) > 0 Then
sRiepilogo = sRiepilogo & "Ruote in gioco : " & GetRuoteInGioco(aRuote) & vbCrLf
If isRuotaValidaLotto(R1) And isRuotaValidaLotto(R2) And PosValida(PR1) And PosValida(PR2) And nSorte <= 2 Then
Call Scrivi(sRiepilogo)
Call Scrivi
For idEstr = Inizio To Fine
b = False
If nNumEstr = 0 Then
b = True
ElseIf nNumEstr = - 1 Then
b = IsUltimaDelMese(idEstr)
ElseIf IndiceMensile(idEstr) = nNumEstr Then
b = True
End If
If b Then
ReDim aNumInGioco(2)
n1 = Fuori90(Estratto(idEstr,R1,PR1) + nDaSommareR1)
n2 = Fuori90(Estratto(idEstr,R2,PR2) + nDaSommareR2)
Select Case sTipoOpTra
Case "*"
aNumInGioco(1) = Fuori90(n1*n2)
Case "/"
aNumInGioco(1) = Iif(n1 > n2,Int(n1/n2),Int(n2/n1))
Case "-"
aNumInGioco(1) = Distanza(n1,n2)
Case "+"
aNumInGioco(1) = Fuori90(n1 + n2)
Case Else
aNumInGioco(1) = n1
aNumInGioco(2) = n2
End Select
If aNumInGioco(2) = 0 Then
ReDim Preserve aNumInGioco(1)
ReDim aPoste(1)
Else
ReDim aPoste(2)
End If
If aNumInGioco(1) <> 0 Then
aPoste(nSorte) = 1
idGiocata = idGiocata + 1
Call ImpostaGiocata(idGiocata,aNumInGioco,aRuote,aPoste,nColpi,nSorte)
Call Gioca(idEstr)
End If
End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
Call ScriviResoconto()
Else
MsgBox "Alcuni dei parametri sono errati." & vbCrLf & vbCrLf & sRiepilogo
Call Scrivi("Parametri errati")
Call Scrivi(sRiepilogo)
End If
Else
MsgBox "Specificare le ruote di gioco",vbExclamation
End If
End Sub
Function PosValida(n)
If n > 0 And n <= 5 Then
PosValida = True
Else
PosValida = False
End If
End Function
Function GetRuoteInGioco(aRuote)
Dim k
Dim sRuote
For k = 1 To UBound(aRuote)
sRuote = sRuote & SiglaRuota(aRuote(k)) & "-"
Next
If sRuote <> "" Then
GetRuoteInGioco = Left(sRuote,Len(sRuote) - 1)
Else
GetRuoteInGioco = ""
End If
End Function
