In Rete..

[Sakti]

In rete ho trovato questo metodo di Cesare Baldazzi , si chiama L'incredibile, Qualche volontario per lo script??
Se è gia stato fatto, come è??

 

[salvo50]

Ciao a Tutti.

Ciao Toon, ecco lo script, salvo errori o dimenticanze

Option Explicit
Sub Main
   Dim Fin,Es,Ini,Clp,Caso,Casi
   Dim R1,R2,P1,P5,P6,Salvo50,Abb1,Abb2
   Dim A,B,E1,E2,Da,Db,Ca,Cb,Co90A,Co90B
   Dim DifDaCa,DifDbCb,CapGioA,CapGioB
   Dim Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2)
   Dim Post2(5),Ruo(2)
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9784) '6976 esempio nell'articolo
   Clp = InputBox("Per quanti colpi vuoi giocare gli ambi?",,5)
   Call ScegliRange(Ini,Fin,Ini,Fin)
   Scrivi "L'INCREDIBILE di CESARE BALDAZZI - Script Salvo50",1,,4,,3,,1
   Post2(2) = 1
   For Es = Ini To Fin
      Messaggio Es
      AvanzamentoElab Ini,Fin,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = CInt(Estratto(Es,R1,P1))
            R2 = R1 + 1
            If R2 = 11 Then R2 = 12
            B = CInt(Estratto(Es,R2,P1))
            If Not Gemello(A) And Not Gemello(B) And A <> B Then
               Da = Decina(A) : Db = Decina(B)
               Ca = Cadenza(A) : Cb = Cadenza(B)
               If(Da > Ca And Db > Cb) Or(Da < Ca And Db < Cb) Then
                  DifDaCa = Distanza(Da,Ca)
                  DifDbCb = Distanza(Db,Cb)
                  If DifDaCa = DifDbCb Then
                     Co90A = ComplAdX(A) : Co90B = ComplAdX(B)
                     CapGioA = Diametrale(Co90A): CapGioB = Diametrale(Co90B)
                     Abb1 = Fuori90(CapGioA + 5): Abb2 = Fuori90(CapGioB + 5)
                     Caso = Caso + 1
                     Casi = Casi + 1
                     Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                     Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                     Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi "  " & SiglaRuota(R1) & " ",1,0
                     For P5 = 1 To 5
                        E1 = Estratto(Es,R1,P5)
                        If E1 = A Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi "  " & SiglaRuota(R2) & " ",1,0
                     For P6 = 1 To 5
                        E2 = Estratto(Es,R2,P6)
                        If E2 = B Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E2) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi
                     Scrivi " Complemento a 90 di " & Format2(A) & " = " & Format2(Co90A) & "   |   Il Diametrale di ",1,0
                     Scrivi Format2(Co90A) & " = " & Format2(CapGioA) & "   |   5 + " & Format2(CapGioA) & " = Abbinamento1 ",1,0
                     Scrivi Format2(Abb1),1
                     Scrivi " Complemento a 90 di " & Format2(B) & " = " & Format2(Co90B) & "   |   Il Diametrale di ",1,0
                     Scrivi Format2(Co90B) & " = " & Format2(CapGioB) & "   |   5 + " & Format2(CapGioB) & " = Abbinamento2 ",1,0
                     Scrivi Format2(Abb2),1
                     Scrivi
                     Ruo(1) = R1 : Ruo(2) = R2
                     Ambo1(1) = CapGioA : Ambo1(2) = Abb1
                     ImpostaGiocata 1,Ambo1,Ruo,Post2,Clp
                     Ambo2(1) = CapGioB : Ambo2(2) = Abb2
                     ImpostaGiocata 2,Ambo2,Ruo,Post2,Clp
                     Ambo3(1) = CapGioA : Ambo3(2) = Abb2
                     ImpostaGiocata 3,Ambo3,Ruo,Post2,Clp
                     Ambo4(1) = CapGioB : Ambo4(2) = Abb1
                     ImpostaGiocata 4,Ambo4,Ruo,Post2,Clp
                     Gioca Es,1
                  End If
               End If
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub

 

[Sakti]

Sempre Gentile e con Grande disponibilità.
Mo lo provo e spero che sia utile a Tutti, Grazie Mille.
Provato, è Perfetto.