Evidenziare estratti Come fare

[Xeroxs]

Buonasera a Tutti,
Dovrei evidenziare degli estratti voluti senza criterio, o meglio se volessi evidenziare il primo di Bari e d il secondo di Cagliari come posso fare, mi basterebbe colorarlo di Rosso, nell'elaborazione dei dati ci riesco ma volendo farlo stampando l'ultima estrazione in questo caso vorrei evidenziare alcuni estratti esiste un modo semplice per farlo, purtroppo non riesco a capire come posso intervenire, intanto che avevo il PC disponibile ho ripreso un metodo in cui ho bisogno di evidenziare dei numeri per non riempire lo script di descrizioni a varie.

Posto il piccolo script su cui intervenire, sperando sia possibile e sperando se si che qualcuno possa aiutarmi a capire come farlo

Sub Main
   Dim nu(5),r,p
   Dim Ini,Fin,es
   Ini = EstrazioneFin
   Fin = EstrazioneFin
   For es = Ini To Fin
      Scrivi GetInfoEstrazione(es),1
      Scrivi
      For r = 1 To 12
         If r = 11 Then r = 12
         For p = 1 To 5
            nu(p) = Estratto(es,r,p)
         Next
         Scrivi SiglaRuota(r) & vbTab & StringaNumeri(nu,,1)
      Next
   Next
End Sub

Grazie come sempre.

 

[i legend]

ciao Xerox
se non sappiamo cosa vuoi evidenziare come possiamo aiutarti?
devi evidenziare dei numeri o delle posizioni?

ora vado a letto che sono stanco se spieghi bene e non ti ha aiutato ancora nessuno , domani provo , se ne sono capace ovviamnte
ciao

 

[Xeroxs]

Grazie I-Legend
Vorrei evidenziare nelle estrazioni che andrò ad esaminare
Il primo ed il quinto estratto di Bari
Il secondo ed il quarto estratto di Cagliari
Il 3 estratto di Firenze
Il secondo ed il quarto estratto di Genova
Il primo ed il quinto estratto di Milano
Formando una croce degli estratti da esaminare.
Sperando che sia possibile farlo.

 

[i legend]

Ciao Xerox guarda se cosi ti va bene
non ho capito l utilita della x
se non vuoi evidenziare gli estratti basta una piccola modifica all if
ecco lo script
ora corro a nanna
se ci sono errori ci pensiamo Domani

Option Explicit
'Grazie I-Legend
'Vorrei evidenziare nelle estrazioni che andrò ad esaminare
'Il Primo ed il quinto Estratto di Bari
'Il secondo ed il quarto Estratto di Cagliari
'Il 3 Estratto di Firenze
'Il secondo ed il quarto Estratto di Genova
'Il Primo ed il quinto Estratto di Milano
'Formando una croce degli estratti da esaminare.
'Sperando che sia possibile farlo.
'
'
'controllare eventuali bugs'
Sub Main
   ReDim aEstrVer(0),aEv(55)
   Dim E,sEstr
   Dim aCol(1)
   Dim R,p,m
   Dim idestr:idestr = EstrazioneFin
   Call ScegliEstratti(aEstrVer,sEstr)
   For E = 1 To UBound(aEstrVer)
      aEv(aEstrVer(E)) = 1
   Next
   Scrivi sEstr
   Scrivi
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi FormatSpace(NomeRuota(R),12) & " | ",,0
      For p = 1 To 5
         m = m + 1
         If aEv(m) Then aCol(1) = vbRed :Else aCol(1) = RGB(239,240,242)
         Scrivi " " & Format2(Estratto(idestr,R,p)) & " ",,0,aCol(1)
      Next
      Scrivi
   Next
End Sub
Sub ScegliEstratti(aEstrVer,sEstr)
   ReDim aVoci(55)
   ReDim aVociSel(55)
   Dim R,m,p
   For R = 1 To 12
      If R = 11 Then R = 12
      For p = 1 To 5
         m = m + 1
         aVoci(m) = p & SiglaRuota(R)
         
         
      Next
   Next
   m = 0
   sEstr = ""
   If ScegliDaLista(aVoci,aVociSel,"Seleziona Estratti di Verifica") >= 0 Then
      For p = 1 To UBound(aVoci)
         If aVociSel(p) Then
            m = m + 1
            ReDim Preserve aEstrVer(m)
            aEstrVer(m) = p
            sEstr = sEstr & aVoci(p) & "  "
         End If
      Next
   End If
End Sub

 

[GioRyuKen72]

Ciao Xerox guarda se cosi ti va bene
non ho capito l utilita della x
se non vuoi evidenziare gli estratti basta una piccola modifica all if
ecco lo script
ora corro a nanna
se ci sono errori ci pensiamo Domani

Option Explicit
'Grazie I-Legend
'Vorrei evidenziare nelle estrazioni che andrò ad esaminare
'Il Primo ed il quinto Estratto di Bari
'Il secondo ed il quarto Estratto di Cagliari
'Il 3 Estratto di Firenze
'Il secondo ed il quarto Estratto di Genova
'Il Primo ed il quinto Estratto di Milano
'Formando una croce degli estratti da esaminare.
'Sperando che sia possibile farlo.
'
'
'controllare eventuali bugs'
Sub Main
   ReDim aEstrVer(0),aEv(55)
   Dim E,sEstr
   Dim aCol(1)
   Dim R,p,m
   Dim idestr:idestr = EstrazioneFin
   Call ScegliEstratti(aEstrVer,sEstr)
   For E = 1 To UBound(aEstrVer)
      aEv(aEstrVer(E)) = 1
   Next
   Scrivi sEstr
   Scrivi
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi FormatSpace(NomeRuota(R),12) & " | ",,0
      For p = 1 To 5
         m = m + 1
         If aEv(m) Then aCol(1) = vbRed :Else aCol(1) = RGB(239,240,242)
         Scrivi " " & Format2(Estratto(idestr,R,p)) & " ",,0,aCol(1)
      Next
      Scrivi
   Next
End Sub
Sub ScegliEstratti(aEstrVer,sEstr)
   ReDim aVoci(55)
   ReDim aVociSel(55)
   Dim R,m,p
   For R = 1 To 12
      If R = 11 Then R = 12
      For p = 1 To 5
         m = m + 1
         aVoci(m) = p & SiglaRuota(R)
        
        
      Next
   Next
   m = 0
   sEstr = ""
   If ScegliDaLista(aVoci,aVociSel,"Seleziona Estratti di Verifica") >= 0 Then
      For p = 1 To UBound(aVoci)
         If aVociSel(p) Then
            m = m + 1
            ReDim Preserve aEstrVer(m)
            aEstrVer(m) = p
            sEstr = sEstr & aVoci(p) & "  "
         End If
      Next
   End If
End Sub

.. bello i Legend, per me è troppo !!
io avevo preparato questo (statico..senza possibilià di scelta), ma è nulla a confronto del tuo:



..prenderò spunti.

Gio.

 

[Xeroxs]

Ciao Gio,
Purtroppo ora non posso controllare con il PC, ma vorrei capire anche la tua soluzione se vuoi postarla, in quanto a volte anche le soluzioni "statiche" per piccole soluzioni vanno bene.
Concordo per quanto fatto da I-Legend è davvero bravo. E dai suoi lavori cerco di capire le vere potenzialità del programma.
Appena posso verifico il tutto anche la tua soluzione se vorrai.
Grazie ad entrambi

 

[GioRyuKen72]

Ciao Xeroxs, molte volte tento di fare gli script per testare le mie capacità.
Mi limito a fare quelli semplici..

Anticipazione (Spoiler): Evidenziare estratti ad X

Sub Main
   ' https://forum.lottoced.com/threads/evidenziare-estratti-come-fare.2199061/
   ColoreTesto 0
   Scrivi "                            Metodo EVIDENZIARE GLI ESTRATTI A X DI XEROXS -- listato GioRyuKen72                              ",1,,2,5
   Scrivi "https://forum.lottoced.com/threads/evidenziare-estratti-come-fare.2199061/",1
   Scrivi
   ColoreTesto 0
   Dim R1,ruo(3),RuoABT(1),Nn(2),E1,E2,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,a,b,Cap,Abb1,Abb2
   Dim Terzina1(3),ambo1(2),ambo2(2),PostaA(2),PostaABT(1),PostaT(3),ambata1(2)
   Dim Somma15,Ba1,Ba5,Ca2,Ca4,Fi3,Ge2,Ge4,Mi1,Mi5
   ex = CInt(InputBox("Quante estrazioni controllo?","Estrazioni",1))
   ini = EstrazioneFin - ex
   fin = EstrazioneFin
   For es = ini To fin
      For P1 = 1 To 1
         For P2 = 2 To 2
            For P3 = 3 To 3
               For P4 = 4 To 4
                  For P5 = 5 To 5
                     Messaggio es
                     Ba1 = Estratto(es,1,P1)
                     Ba5 = Estratto(es,1,P5)
                     Ca2 = Estratto(es,2,P2)
                     Ca4 = Estratto(es,2,P4)
                     Fi3 = Estratto(es,3,P3)
                     Ge2 = Estratto(es,4,P2)
                     Ge4 = Estratto(es,4,P4)
                     Mi1 = Estratto(es,5,P1)
                     Mi5 = Estratto(es,5,P5)
                     '______________________________________
                     Scrivi("Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi
                     Scrivi "  " & SiglaRuota(1) & " ",1,0
                     For P6 = 1 To 5
                        E1 = Estratto(Es,1,P6)
                        If E1 = Ba1 Or E1 = Ba5 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(2) & " ",1,0
                     For P7 = 1 To 5
                        E1 = Estratto(Es,2,P7)
                        If E1 = Ca2 Or E1 = Ca4 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(3) & " ",1,0
                     For P8 = 1 To 5
                        E1 = Estratto(Es,3,P8)
                        If E1 = Fi3 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(4) & " ",1,0
                     For P9 = 1 To 5
                        E1 = Estratto(Es,4,P9)
                        If E1 = Ge2 Or E1 = Ge4 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(5) & " ",1,0
                     For P10 = 1 To 5
                        E1 = Estratto(Es,5,P10)
                        If E1 = Mi1 Or E1 = Mi5 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(6) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,6," "),1
                     Scrivi "  " & SiglaRuota(7) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,7," "),1
                     Scrivi "  " & SiglaRuota(8) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,8," "),1
                     Scrivi "  " & SiglaRuota(9) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,9," "),1
                     Scrivi "  " & SiglaRuota(10) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,10," "),1
                     Scrivi "  " & SiglaRuota(12) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,12," "),1
                     Scrivi String(24,"-"),1,,,0
                     ' Scrivi String(70,"-"),1
                     'ColoreTesto 1
                     ' Scrivi "CONDIZIONE RILEVATA: " & Format2(Nn(1)) & "  +  " & Format2(Nn(2)) & "  =   " & Format2(Somma15),1,0
                     ' ColoreTesto 0
                     ' Scrivi
                     ' Scrivi String(70,"-"),1
                     ' Scrivi "Capigioco  : " & Format2(Cap),1
                     ' Scrivi "Abbinamenti: " & Format2(Abb1) & " e " & Format2(Abb2),1
                     ' ColoreTesto 0 : Scrivi String(70,"-"),1
                     ' Scrivi
                     'Gioca es,True,,1
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit For
   Next
   Scrivi
   Scrivi "Casi totali (" & casi & ")",1
   TestoInBandaPassante " *****  EVIDENZIARE GLI ESTRATTI A X DI XEROXS  -- listato GioRyuKen72 ***** ",1,3,0
   ScriviDistribuzioneEsiti(True)
   ScriviDistribuzioneCasiInCorso(True)
   ScriviResoconto
End Sub

Gio.

 

[Xeroxs]

Per il momento ti ringrazio, Gio
Appena posso vedrò il tutto

 

[Xeroxs]

Ciao a Tutti e Buongiorno.
Che Dire ho lanciato gli Script di Entrambi e di Questo Vi Ringrazio,
Davvero Che Dire I-Legend Proponi sempre dei lavori e delle soluzioni sempre ad un Livello che Io neanche immaginavo il programma potesse esprimere, evidentemente hai così bene assorbito la materia fino a dare sfogo ad ogni possibile soluzione dalla più banale alla più complessa come ho visto dai Tuoi Lavori, davvero Bravo.
Con Questo Ovvio è Anche utile quanto fatto da Giò, Devo infatti anche pensare che se sviluppo poi uno script-Metodo e se devo passarlo alla mia amica non masticando molto di Script devo proporre qualcosa anche basato sulle basi.
Grazie Davvero Giò, Sarà anche Utile la tua soluzione, e da quel che vedo entrambe le soluzioni saranno davvero utili per me per apprendere sempre qualcosa di Nuovo.
Come mi ricorda spesso anche Claudio8, che saluto l'help che viene proposto dal programma è davvero utile e ben esposto, infatti lo sto visionando anche su Voci ancora mai utilizzate, ma non tutto come ovvio può essere riportato è quì entrate Voi con le Vostre soluzioni per supportare Me e quelli meno, a Volte molto meno esperTi.

Grazie Ancora

 

[i legend]

Grazie a tutti
Salvo, GioRiuken72,Xerox
Grazie

 

[i legend]

Ciao a tutti.
Se si dovesse fare una ricerca su più estrazioni lo script andrebbe ottimizzato.
Se qualcuno vuole cimentarsi , utilizzando la stessa logica , con qualche piccolo accorgimento ci si riesce facilmente.
Altrimenti lo posto io , è davvero solo un piccolo accorgimento.
Buon lavoro.

 

[joe]

Buona serata a tutte/i.

Sub Main
   For R = 1 To 5
      A = FuoriX(R,5) : B = FuoriX(6 - R)
      For P = 1 To 5
         If P = A Or P = B Then Scrivi SiglaRuota(R) & " ",0,0 Else Scrivi Space(3),0,0
      Next
      Scrivi
   Next
End Sub

Così com'è gira solo su Spaziometria.

 

[*blacklotto*]

Grazie Joe, molto, molto interessante.

Un piccolo script che permette molte possibilità.

 

[joe]

Grazie Joe, molto, molto interessante.

Un piccolo script che permette molte possibilità.

Ringrazio te e Xeroxs per il gradimento.

Un saluto a tutte/i.

 

[Xeroxs]

Ciao Joe,
Non è solo un semplice gradimento, Esponi sempre spunti che per chi ha voglia di apprendere è un ottimo stimolo, preso da questo ho creato una base per portare avanti e/o migliorare un metodo che devo fare.

Sub Main
   Dim Ini,Fin,es,K
   Dim R,P
   Dim A,B
   Ini = EstrazioneFin - 1
   Fin = EstrazioneFin
   For es = Ini To Fin
      ColoreTesto 1
      K = K + 1
      Scrivi "Estrazione n." & Format2(es) & " Del " & DataEstrazione(es) & " " & String(80,"*") & " Caso n°" & Format2(K),1
      Scrivi
      For R = 1 To 5
         A = FuoriX(R,5) : B = FuoriX(6 - R)
            Scrivi SiglaRuota(R) & " ",1,False
      Next
      Scrivi
      For R = 1 To 5
         A = FuoriX(R,5) : B = FuoriX(6 - R)
         For P = 1 To 5
            ColoreTesto 2
            If P = A Or P = B Then Scrivi Estratto(es,R,P) & " ",0,0 Else Scrivi Space(3),0,0
         Next
         Scrivi
      Next
      Scrivi
   Next
End Sub

Sempre preso da quanto creato e proposto da Te, ho provato a partire dalla ruota successiva ma non mi espone i valori nello stesso modo, puoi farmi capire il perchè, dove sbaglio?

Sub Main
   Dim Ini,Fin,es,K
   Dim R,P
   Dim A,B
   Ini = EstrazioneFin - 1
   Fin = EstrazioneFin
   For es = Ini To Fin
      ColoreTesto 1
      K = K + 1
      Scrivi "Estrazione n." & Format2(es) & " Del " & DataEstrazione(es) & " " & String(80,"*") & " Caso n°" & Format2(K),1
      Scrivi
      For R = 2 To 6
         A = FuoriX(R,6) : B = FuoriX(7 - R)
            Scrivi SiglaRuota(R) & " ",1,False
      Next
      Scrivi
      For R = 2 To 6
         A = FuoriX(R,6) : B = FuoriX(7 - R)
         For P = 1 To 5
            ColoreTesto 2
            If P = A Or P = B Then Scrivi Estratto(es,R,P) & " ",0,0 Else Scrivi Space(3),0,0
         Next
         Scrivi
      Next
      Scrivi
   Next
End Sub

Ok per le ruote ma non per gli estratti corrispondenti, dovrei intervenire sulle posizioni ma non capisco come...

 

[joe]

Ciao Xeroxs,

E' un pochino complicato spostare gli intervalli delle ruote.

Empiricamente si possono costruire dei "modelli" ed osservare cosa e come si devono modificare,

alcuni dei valori affinché tutto funzioni bene.

Dopo aver trovato l'algoritmo (cioè il modo con cui cambiano i valori al cambiare dell'intervallo di ruote)

cioè quando si è sintetizzato il modello matematico, si può inserirlo nei calcoli della funzione "visualizza X".

Teoricamente si può (e qualcuno ne è sicuramente capace di) costruire a mente il tutto come opera di ingenio

Tuttavia, reputo sia oltre i miei limiti e/o la mia voglia di verificarlo.

Dunque ti propongo solo il primo step-up di quanto ho appena proposto.

Option Explicit
Sub Main
  Dim E,R,P,A,B
  For R = 2 To 6
    Scrivi SiglaRuota(R),1,0
    A = FuoriX(R,6) : B = FuoriX(7-R)
    For P = 1 To 5
      E = Estratto(EstrazioneFin,R,P)
      If P = A-1 Or P = B Then
        Scrivi Space(1) & Format2(E),1,0,,2
      Else
        Scrivi Space(1) & Format2(E),0,0
      End If
    Next
    Scrivi
  Next
End Sub

 

[Xeroxs]

Che Dire, Sembro un bambino difronte alla agognata cioccolata che tanto bramavo...
Sempre preciso/bravo nell' esporre soluzioni ottimali

 

[joe]

Ringrazio nuovamente per la stima e per l'attenzione.

Come ho accennato e scritto molto-molto tra le righe, principalmente ci sono 5 script.

Il primo inizia da Bari il secondo da Cagliari, ecc. ecc.

Quindi fatti i 5 script si può richiamare quello che inizia con la "ruota giusta".

Fatto questo basta osservare cosa cambia in tutti questi script dall'uno all'altro

e poi agire di conseguenza per averne uno solo richiamabile in funzione della ruota iniziale.

per esempio tra il primo ed il secondo ci sono queste differenze:

A = FuoriX(R,5) : B = 6 - R

A = FuoriX(R,6) : B = 7-R



If P = A Or P = B Then

If P = A-1 Or P = B Then


Quando, si riesce a trovare il modo capace di descrivere ... questi cambiamenti ...

si possono unificare tutti e 5 in una sola routine.

 

[Master]

Ciao a tutti
Grazie Joe per averci regalato questa nuova formula
con un po di fatica sono riuscito a lavorare con tutte e 11 le ruote
sempre preziosi i tuoi consigli senza nulla togliere alla competenza di ilegend,Mike58,Claudio, ed altri maestri

 

[joe]

In questa nuova versione ... (Ringraziando Master per la fatica parallela)

ho riassunto quanto era in ipotesi di potersi realizzare.

Attenzione: Non ho imposto limitazioni e verifica per altre ruote,

quindi funziona solo per il quadro estrazionale a 10 ruote.

Option Explicit
Sub Main
Dim Es,R
Es = EstrazioneFin
For R = 1 To 5
Call VisualizzaX (Es,R)
Next
End Sub

Function VisualizzaX (Es,R)
  Dim E,P,A,B,L,M,X
  L = R : M = R + 4
  Scrivi DataEstrazione (Es,,,"/"),True
  For X = L To M
    Scrivi SiglaRuota(X),1,0
    A = FuoriX(X,5+R) : B =  M+1-X
    For P = 1 To 5
      E = Estratto(Es,X,P)
      If P = A-R+1 Or P = B Then
        Scrivi Space(1) & Format2(E),1,0,,2
      Else
        Scrivi Space(1) & Format2(E),0,0
      End If
    Next
    Scrivi
  Next
  Scrivi Scrivi
End Function