Cerco listato che

[solare]

Ciao, esiste un listato che trovi numeretti consecutivi ?

 

[salvo50]

Ciao Solare, non lo sò se esiste già uno script con i numeretti consecutivi, te ne ho fatto uno io, ed in un'altro ho modificato uno script di LuigiB.

Mio

 'Progetto chiesto da Solare - Numeretti Consecutivi
'Script   - by Salvo50
Option Explicit
Sub Main
    Dim R1,P1,P2,Es,Esq,Caso,Casi
    Dim FIn,Ini,A,B
    Dim Idestr,Col,Esqcol
    FIn = EstrazioneFin
    Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",Idestr,8395)
    Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,2000))
    Esqcol = Esq + Col
    If Esqcol > FIn Then Esqcol = FIn
    For Es = Esq To Esqcol
        Caso = 0
        AvanzamentoElab Esq,Esqcol,Es
        For R1 = 1 To 12
            If R1 = 11 Then R1 = 12
            For P1 = 1 To 4
                P2 = P1 + 1
                A = Estratto(Es,R1,P1)
                B = Estratto(Es,R1,P2)
                If A > 0 Then
                    If A < 10 And B < 10 Then
                        Caso = Caso + 1
                        Casi = Casi + 1
                        ColoreTesto 1
                        Scrivi String(89,"=") & " Casi Totali " & FormattaStringa(Casi,"0000")
                        ColoreTesto 0
                        Scrivi String(80,"=") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                        Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                        Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1,0
                        Scrivi " Numeretti Consecutivi -->  ",1,0
                        ColoreTesto 2
                        Scrivi Format2(A) & Space(1) & Format2(B)
                        ColoreTesto 0
                        Scrivi String(105,"-")
                    End If
                End If
            Next
        Next
        If ScriptInterrotto Then Exit Sub
    Next
End Sub

Di LuigiB Modificato

 'Script di LuigiB, Modificato da Salvo50
Option Explicit
Sub Main
    Dim sTesto
    Dim n,r,e,es,Ini,fin
    Dim Bold,Color,hcolor,size,sName,Underline,Striked
    fin = EstrazioneFin
    Ini = fin - 200
    Bold = True ' grassetto (true/false)
    Color = vbRed ' colore (un colore valido)
    hcolor = - 1 ' colore di evidenziatore un colore valido o -1 per nessun colore
    size = 2 ' dimensione del carattere
    sName = "Courier new" ' nome font
    Underline = True ' sottolineato (true/false)
    Striked = False ' barrato  (true/false)
    For es = Ini To fin
        Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es))
        Scrivi
        For r = 1 To 12
            If r = 11 Then r = 12
            sTesto = ""
            Scrivi Space(16) & SiglaRuota(r) & " ",0,0
            For e = 1 To 5
                n = Format2(Estratto(es,r,e))
                If n < 10 Then
                    ' se il numero è un numeretto applica lo stile del testo
                    sTesto = sTesto & GetTestoHtml(n,Bold,Color,hcolor,size,sName,Underline,Striked) & " "
                Else
                    ' se il numero non è un numeretto scrive con lo stile di default
                    sTesto = sTesto & n & " "
                End If
            Next
            Scrivi sTesto
        Next
        Scrivi Space(16) & String(17,"*")
        Scrivi
    Next
End Sub

 

[solare]

Grazie infinite