cartomantedaniel
Banned
Buongiorno , questo script (non suo), che gentilmente Baffoblu mi ha messo a disposizione....può vedere
tutti gli ambi uguali sortiti dal 1939
in avanti.
A me servirebbe una finestrella ( imput box) che mi permetta di inserire e quindi andare a ricercare a ritroso l'ambo rip.scelto.
Spero sia possibile .
Saluto e ringrazio fin da ora quell'anima generosa che mi fara' questo favore.
A buon rendere...
Sub Main
Dim idEstr
Dim CollAmbiTrovati
Dim sAmbo
Dim qEstrTrovate
Dim clsCoppia
idEstr = 3500
Do While qEstrTrovate < 10 And idEstr > 0
If GetAmbiUguali(idEstr,CollAmbiTrovati) > 3 Then
qEstrTrovate = qEstrTrovate + 1
Call Scrivi(DataEstrazione(idEstr),True)
Call DisegnaEstrazione(idEstr)
For Each clsCoppia In CollAmbiTrovati
sAmbo = ""
sAmbo = sAmbo & clsCoppia.clsNumero(1).numero & " - " & clsCoppia.clsNumero(2).numero & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(1).ruota) & " Num " & clsCoppia.clsNumero(1).numero & " in posizione " & clsCoppia.clsNumero(1).Posizione & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(2).ruota) & " Num " & clsCoppia.clsNumero(2).numero & " in posizione " & clsCoppia.clsNumero(2).Posizione & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(3).ruota) & " Num " & clsCoppia.clsNumero(3).numero & " in posizione " & clsCoppia.clsNumero(3).Posizione & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(4).ruota) & " Num " & clsCoppia.clsNumero(4).numero & " in posizione " & clsCoppia.clsNumero(4).Posizione & vbCrLf
Call Scrivi(sAmbo)
Next
End If
Call Messaggio("Estrazioni trovate : " & qEstrTrovate)
Call AvanzamentoElab(1,10,qEstrTrovate)
If ScriptInterrotto Then Exit Do
idEstr = idEstr - 1
Loop
End Sub
tutti gli ambi uguali sortiti dal 1939
in avanti.
A me servirebbe una finestrella ( imput box) che mi permetta di inserire e quindi andare a ricercare a ritroso l'ambo rip.scelto.
Spero sia possibile .
Saluto e ringrazio fin da ora quell'anima generosa che mi fara' questo favore.
A buon rendere...
Sub Main
Dim idEstr
Dim CollAmbiTrovati
Dim sAmbo
Dim qEstrTrovate
Dim clsCoppia
idEstr = 3500
Do While qEstrTrovate < 10 And idEstr > 0
If GetAmbiUguali(idEstr,CollAmbiTrovati) > 3 Then
qEstrTrovate = qEstrTrovate + 1
Call Scrivi(DataEstrazione(idEstr),True)
Call DisegnaEstrazione(idEstr)
For Each clsCoppia In CollAmbiTrovati
sAmbo = ""
sAmbo = sAmbo & clsCoppia.clsNumero(1).numero & " - " & clsCoppia.clsNumero(2).numero & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(1).ruota) & " Num " & clsCoppia.clsNumero(1).numero & " in posizione " & clsCoppia.clsNumero(1).Posizione & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(2).ruota) & " Num " & clsCoppia.clsNumero(2).numero & " in posizione " & clsCoppia.clsNumero(2).Posizione & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(3).ruota) & " Num " & clsCoppia.clsNumero(3).numero & " in posizione " & clsCoppia.clsNumero(3).Posizione & vbCrLf
sAmbo = sAmbo & "Ruota " & NomeRuota(clsCoppia.clsNumero(4).ruota) & " Num " & clsCoppia.clsNumero(4).numero & " in posizione " & clsCoppia.clsNumero(4).Posizione & vbCrLf
Call Scrivi(sAmbo)
Next
End If
Call Messaggio("Estrazioni trovate : " & qEstrTrovate)
Call AvanzamentoElab(1,10,qEstrTrovate)
If ScriptInterrotto Then Exit Do
idEstr = idEstr - 1
Loop
End Sub