Novità

10 e lotto ogni 5 minuti genius NUOVA VERSIONE

R

rol65

Guest
UN GRANDE LAVORO DI AVATAR IN CONTINUO AGGIORNAMENTO.
E UN RINGRAZIAMENTO X AVERLO MESSO A DISPOSIZIONE DI TUTTI.
GRAZIE.

NUOVA VERSIONE COMPLETA

Qui ci sono i link dove scaricare sia il programma che la guida

Guida 10eLotto Genius
DepositFiles

10eLotto Genius tutti i giorni
DepositFiles

Attenzione x aggiornare l'archivio e' stato modificato il plugin fatto dal grande LuigiB

questa e' la versione script x spaziometria 1.4.20 e successive
modificato il 27-03-2013

Codice: 
Option Explicit
Dim xlApp ' oggetto excel
Dim xlBook ' insieme di cartelle di lavoro
Dim xlSheet ' foglio di lavoro
Const xlCalculationManual = - 4135 '(&HFFFFEFD9)
Const xlCalculationAutomatic = - 4105 '(&HFFFFEFF7)
Const xlMaximized = - 4137 '(&HFFFFEFD7)
Const xlMinimized = - 4140 '(&HFFFFEFD4)
Sub Main
    Dim nEstrInizio,nEstrFine
    Dim DataIni,DataFin
    Dim FasciaOrariaIni,FasciaOrariaFin
    Dim sFile
    Dim sChrSep
    sChrSep = "|"
    If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire l'export ?",vbQuestion + vbYesNo) = vbYes Then
        Call AggiornaArchivioDL
    End If
    Call ImpostaArchivio10ELotto(2)
    If MsgBox("Vuoi aggiornare direttamente il foglio excel ?" & vbCrLf & "Premendo NO verrà creato il file di testo" & _
        vbCrLf & "Se premi SI il foglio SPIAMO I NUMERI deve essere aperto",vbQuestion + vbYesNo) = vbYes Then
        If IstanziaExcel Then
            xlApp.WindowState = xlMinimized
            Call AbilitaCalcoloXls(False)
            Call AggiornaExcel(sChrSep)
            Call AbilitaCalcoloXls(True)
            xlApp.WindowState = xlMaximized
        End If
    Else
        sFile = GetDirectoryAppData & "Estrazioni10Lotto5M.txt"
        If EliminaFile(sFile) Then
            If ChiediDataInizioFine(DataIni,DataFin) Then
                If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin) Then
                    nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
                    nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
                    If IsRangeValido(nEstrInizio,nEstrFine) Then
                        Call EsportaEstr(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,sFile,sChrSep,False,0,0,0)
                    End If
                End If
            End If
        End If
    End If
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub
Sub AggiornaExcel(sChrSep)
    Dim sOrario,nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin
    Dim DataIni,DataFin
    Dim bChiedi
    Dim sLastData,nLastId,nProgr,idRigaXls
    sOrario = GetRangeOrarioDaFoglioXls(FasciaOrariaIni,FasciaOrariaFin)
    If sOrario <> "" Then
        Call GetLastDataIdProgr(sLastData,nLastId,nProgr,idRigaXls)
        If MsgBox("E' stato rilevato il range orario " & sOrario & vbCrLf & _
            "L'ultima data in archivio risulta : " & sLastData & _
            vbCrLf & "L'ultima giocata oraria è : " & GetOrario(nLastId) & _
            vbCrLf & "Accodare le estrazioni nuove nel range orario previsto ?" & _
            vbCrLf & "Premendo NO , il foglio archivio verra aggiornato" & _
            " daccapo e sara possibile scegliere il range ",vbQuestion + vbYesNo) = vbYes Then
            bChiedi = False
        Else
            bChiedi = True
        End If
    Else
        bChiedi = True
    End If
    If bChiedi Then
        If ChiediDataInizioFine(DataIni,DataFin) Then
            If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin) Then
                nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
                nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
                If IsRangeValido(nEstrInizio,nEstrFine) Then
                    xlSheet.Cells.Select
                    xlSheet.Cells.Range("A7:Z50000").ClearContents

                    Call EsportaEstr(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,"",sChrSep,True,6,0,0)
                End If
            End If
        End If
    Else
        DataIni = FormattaStringa(sLastData,"dd/mm/yyyy")
        DataFin = FormattaStringa(Now,"dd/mm/yyyy")
        nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
        nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
        xlSheet.Cells.Select
        Call EsportaEstr(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,"",sChrSep,True,idRigaXls,nProgr,nLastId)
    End If
End Sub
Sub EsportaEstr(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,sFile,sChrSep,bAggiornaXls,nPrimaRigaXls,nProgrXls,nLastFasciaOrario)
    Dim k,f,idEstr
    Dim sRecord
    Dim nProgr
    Dim sDataCorr
    Dim idRigaXls
    idRigaXls = nPrimaRigaXls
    nProgr = nProgrXls
    For k = nEstrInizio To nEstrFine Step 228
        Call Messaggio("Estrazione : " & k)
        For f = FasciaOrariaIni To FasciaOrariaFin
            If f > nLastFasciaOrario Then
                idEstr =(k - 1) + f
                ReDim aNum(0)
                If GetEstrazioneCompletaDL(idEstr,aNum) Then
                    nProgr = nProgr + 1
                    sDataCorr = Replace(DataEstrazioneDL(idEstr),".","/")
                    sRecord = FormatSpace(nProgr,9,True) & sChrSep
                    sRecord = sRecord & FormatSpace(f,3,True) & sChrSep
                    sRecord = sRecord & GetOrario(f) & sChrSep
                    sRecord = sRecord & Format2(Day(sDataCorr)) & sChrSep
                    sRecord = sRecord & FormattaStringa(sDataCorr,"dd mmm yyyy") & sChrSep
                    sRecord = sRecord & sChrSep
                    sRecord = sRecord & StringaNumeri(aNum,sChrSep,True)
                    If bAggiornaXls Then
                        idRigaXls = idRigaXls + 1
                        Call AddRigaXls(idRigaXls,sRecord,nProgr,sChrSep)
                    Else
                        Call ScriviFile(sFile,sRecord,False,True)
                    End If
                Else
                    Exit For
                End If
            End If
            If ScriptInterrotto Then Exit For
        Next
        nLastFasciaOrario = 0
        If ScriptInterrotto Then Exit For
        Call AvanzamentoElab(nEstrInizio,nEstrFine,k)
    Next
    If bAggiornaXls = False Then
        Call CloseFileHandle(sFile)
        Call LanciaFile(sFile)
    Else
        xlSheet.cells(1,1).select
        xlSheet.select
    End If
End Sub
Function IsRangeValido(Inizio,Fine)
    Dim b
    b = False
    If Inizio > 0 And Fine > 0 Then
        If Fine >= Inizio Then
            b = True
        End If
    End If
    If Not b Then
        MsgBox "Range non valido , probabilemente mancano le estrazioni nella base dati " & _
        vbCrLf & "EstrazioneIni : " & Inizio & vbCrLf & "EstrazioneFine  : " & Fine
    End If
    IsRangeValido = b
End Function
Function ChiediDataInizioFine(DataI,DataF)
    If Not IsDate(DataF) Then DataF = FormattaStringa(Now,"dd/mm/yyyy")
    If Not IsDate(DataI) Then DataI = FormattaStringa(DateAdd("d",-(30),DataF),"dd/mm/yyyy")
    DataI = InputBox("Inserire data inizio ricerca in formato GG/MM/AAAA","Data inizio",DataI)
    DataF = InputBox("Inserire data fine ricerca in formato GG/MM/AAAA","Data fine",DataF)
    If IsDate(DataI) And IsDate(DataF) Then
        If DateDiff("d",DataI,DataF) >= 0 Then
            ChiediDataInizioFine = True
        Else
            MsgBox "La data FINE deve essere maggiore od uguale alla data INIZIO"
        End If
    Else
        MsgBox "Date inserite non valide"
    End If
End Function
Function GetOrario(id)
    Dim h,m
    h = id \12
    m = id Mod 12
    If h = 0 Then
        h = 5
    Else
        h = 5 + h
    End If
    If m = 12 Then
        GetOrario = Format2(h) & ":00"
    Else
        If h = 24 Then
            GetOrario = "23:59"
        Else
            GetOrario = Format2(h) & ":" & Format2(m * 5)
        End If
    End If
End Function
Function ChiediFasciaInizioFine(FasciaI,FasciaF)
    FasciaI = ChiediFasciaOraria("Fascia oraria inizio",1)
    FasciaF = ChiediFasciaOraria("Fascia oraria fine",228)
    If FasciaI > 0 And FasciaF > 0 Then
        If FasciaF >= FasciaI Then
            ChiediFasciaInizioFine = True
        Else
            MsgBox "La fascia oraria Fien deve essere maggiore della fascia oraria INIZIO"
        End If
    Else
        MsgBox "Fascie orarie non valide"
    End If
End Function
Function ChiediFasciaOraria(sCaption,nSel)
    Dim aLista(228)
    Dim h,m
    Dim i
    For h = 5 To 23
        For m = 5 To 60 Step 5
            i = i + 1
            If m = 60 Then
                aLista(i) = Format2(h + 1) & ":00"
            Else
                aLista(i) = Format2(h) & ":" & Format2(m)
            End If
        Next
    Next
    aLista(i) = "23:59"
    ChiediFasciaOraria = ScegliOpzioneMenu(aLista,nSel,sCaption)
End Function
Function GetFoglioArchivio
    On Error Resume Next
    Set xlBook = xlApp.Workbooks(1)
    Set xlSheet = xlBook.sheets("archivio")
    If Err.number <> 0 Then
        MsgBox "Il foglio excel SPIAMO I GIORNI deve essere aperto e contenere il foglio di nome <archivio>"
    Else
        GetFoglioArchivio = True
    End If
End Function
Function GetExcel
    On Error Resume Next
    Set xlApp = GetObject(,"Excel.Application")
    If Err.number <> 0 Then
        MsgBox "Il foglio excel SPIAMO I GIORNI deve essere aperto"
    Else
        GetExcel = True
    End If
End Function
Function IstanziaExcel
    If GetExcel Then
        If GetFoglioArchivio Then
            IstanziaExcel = True
        End If
    End If
End Function
Sub AddRigaXls(idRiga,sRecord,nProgr,sChrSep)
    'Dim idRiga
    Dim k
    ReDim aV(0)
    Call Messaggio("Aggiungo estrazione : " & nProgr)
    Call SplitByChar(sRecord,sChrSep,aV)
    'idRiga = nProgr +(7 - 1)
    For k = 0 To UBound(aV)
        xlSheet.cells(idRiga,k + 1) = aV(k)
    Next
End Sub
Sub AbilitaCalcoloXls(b)
    Dim xlSh
    For Each xlSh In xlBook.worksheets
        xlSh.enablecalculation = b
    Next
    If b Then
        xlApp.calculation = xlCalculationAutomatic
    Else
        xlApp.calculation = xlCalculationManual
    End If
End Sub
Function GetRangeOrarioDaFoglioXls(nStart,nEnd)
    Dim k
    Call Messaggio("Lettura archivio precedente")
    nStart = 0
    nEnd = 0
    k = 7
    nStart = Int(xlSheet.cells(k,2))
    Do
        nEnd = Int(xlSheet.cells(k,2))
        k = k + 1
    Loop While nEnd < Int(xlSheet.cells(k,2))
    If nStart > 0 And nEnd > 0 Then
        GetRangeOrarioDaFoglioXls = GetOrario(nStart) & "-" & GetOrario(nEnd)
    Else
        GetRangeOrarioDaFoglioXls = ""
    End If
End Function
Function GetLastDataIdProgr(sLastData,nLastId,nProgr,idRigaXls)
    Dim k,i
    Call Messaggio("Lettura archivio precedente")
    sLastData = ""
    nLastId = 0
    nProgr = 0
    idRigaXls = 0
    Do
        k = k + 100
    Loop While xlSheet.cells(k,1) <> ""
    For i = k To 1 Step - 1
        If xlSheet.cells(i,1) <> "" Then
            sLastData = xlSheet.cells(i,5)
            nLastId = Int(xlSheet.cells(i,2))
            nProgr = Int(xlSheet.cells(i,1))
            idRigaXls = i
            Exit For
        End If
    Next
End Function
 
Ultima modifica:
S

stefano.az

Super member
10 e lotto ogni 5 minuti genius

10 e lotto ogni 5 minuti genius

Di che si tratta? Sono con l'iphone e mi è impossibile aprire i file
 
R

Roby

Guest
Ciao Stefano, si tratta del nuovo spiamo i numeri, è composto di un file guida ben fatto dal grande Avatar
e da 31 fogli 1 x giorno.
E' un bel programma ma bisogna leggere molto bene la guida x capirne le potenzialità.
A domani
 
S

stefano.az

Super member
10 e lotto ogni 5 minuti genius

10 e lotto ogni 5 minuti genius

Grazie Rol. Cosa cambia rispetto al vecchio oltre che ad essere su 31 fogli diversi?
 
R

Roby

Guest
Ciao Stefano, dovresti scaricare la guida x iniziare a capirci qualcosina su questo programma,
oltre alle clasiche frequenze il tutto supportato dalla sommativa, diciamo la sommativa applicata al 10elotto5min
ma con la diversità che non prende il 1° estr + questo e + quello ecc. ecc. ma alle frequenze viene applicata la sommativa.
questo solo x darti un'idea, è tutto da studiare.
Ciao
 
keeper

keeper

Advanced Member >PLATINUM PLUS<
complimenti ragazzi l'unica cosa per scricare i fogli non era meglio comprimerli in una sola cartella ed uplodarla?
 
R

Roby

Guest
Ciao Keeper certo ma ci vuole molto tempo a creare gli archivi e per far incominciare a studiare i fogli abbiamo iniziato a metterli a disposizione di tutti,
io stesso ho solo quelli pubblicati, man mano che Avatar mi manda i fogli io li pubblico.
Ciao
 
R

Roby

Guest
Attenzione scaricate l'ultima versione
IN PRIMA PAGINA
1° gestisce tutti i giorni
2° l'archivio puo' essere aggiornato col programma fatto da luigib

CON GRANDISSIMO SACRIFICIO AVATAR E' RIUSCITO A SISTEMARE IL TUTTO
datevi da fare e studiateci sopra.
 
Ultima modifica:
P

pgioy

Member
ciao rol65
bel lavoro,anzi lavorone...
solo una domanda anzi due , ho fatto la prova a cambiare l'archivio dalle 18.00 alle 19.30
lui si aggiorna ,ma tutti i risulati sono a zero ,forse ho fatto una cavolata,perchè a differenza deel'altro cambiavo i dati al pulsante
e lui si ricalcolava il tutto, qui non so dove mettere mani anora.
Posso inserire altri terni e ambi in quella lista,oppure se vuoi te li do a te per fare un aggiornamento del file perche ho 4 numeri che si inseguono spesso nell' arco della giornata .
ciao grazie
 
R

Roby

Guest
Ciao pgioy, ci siamo già accorti del problema e Avatar oggi sta cercando di risolverlo,
x il momento si può solo aggiungere l'estrazioni e non rifare il tutto, appena pronto lo pubblico subito (spero entro oggi).
x i terni devo controllare.
A dopo
 
R

Roby

Guest
Attenzione x aggiornare l'archivio e' stato modificato il plugin fatto dal grande LuigiB

andate in 1° pagina
ciao

 
P

pgioy

Member
10 e lotto ogni 5 minuti genius NUOVA VERSIONE

ciao rol65
c'è ancora qualcosa che non torna
Per esempio con lo script per aggiornare
Nel cambiare data ,quando sente l' ultima data disponibile me la sente in americano e la seconda in italiano, con spazio sono alla 1.4.5
con questo problema non aggiorna anche quello esistente. Però con spazio 1.3.77funziona tutto ma lascia in xls come ti dicevo ieri.
ciao
 
R

Roby

Guest
Ciao pgioy scusa x il ritardo ma a me funziona bene come vidoque slottina avatar rocco48 desideri quindi il problema è sul tuo pc,
prova a disinstallare spaziometria col disinstallatore messo a disposizione da LuigiB, poi rifai l'installazione e riprova il tutto.
Ciao
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 19 aprile 2024
    Bari
    39
    05
    81
    89
    73
    Cagliari
    56
    21
    01
    90
    03
    Firenze
    05
    56
    68
    27
    09
    Genova
    42
    50
    90
    27
    83
    Milano
    16
    71
    29
    85
    04
    Napoli
    29
    19
    23
    63
    50
    Palermo
    35
    54
    33
    57
    61
    Roma
    17
    29
    43
    55
    74
    Torino
    69
    60
    03
    01
    26
    Venezia
    05
    57
    59
    43
    34
    Nazionale
    30
    43
    64
    65
    21
    Estrazione Simbolotto
    Genova
    02
    20
    25
    12
    19
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Alto