10 e lotto ogni 5 minuti genius NUOVA VERSIONE

rol65 · 7 Febbraio 2013

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

Roby · 7 Febbraio 2013

Ciao Rol, hai fatto l'upload solo della guida?

Roby · 7 Febbraio 2013

Ciao Slottina, tra poco Avatar corregge il link
poi lo posto.
Ciao

passiflora · 7 Febbraio 2013

Grazie Avatar rol e tutti

stefano.az · 7 Febbraio 2013

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

Roby · 7 Febbraio 2013

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

stefano.az · 8 Febbraio 2013

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?

rocco48 · 8 Febbraio 2013

ciao avatar e rol bel lavoro speriamo che porti belle vincite a tutti

Roby · 8 Febbraio 2013

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 · 8 Febbraio 2013

complimenti ragazzi l'unica cosa per scricare i fogli non era meglio comprimerli in una sola cartella ed uplodarla?

Roby · 8 Febbraio 2013

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

keeper · 8 Febbraio 2013

grazie rol65

keeper · 8 Febbraio 2013

attenderò le vostre previsioni

Roby · 9 Febbraio 2013

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.

passiflora · 9 Febbraio 2013

Grazie Ragazzi,fatto

pgioy · 10 Febbraio 2013

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

Roby · 10 Febbraio 2013

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

Roby · 10 Febbraio 2013

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

andate in 1° pagina
ciao

pgioy · 11 Febbraio 2013

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

Roby · 11 Febbraio 2013

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

10 e lotto ogni 5 minuti genius NUOVA VERSIONE

rol65

Guest

Roby

Guest

Roby

Guest

Advanced Member

Super member

Roby

Guest

Super member

Super Member >PLATINUM<

Roby

Guest

Advanced Member >PLATINUM PLUS<

Roby

Guest

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Roby

Guest

Advanced Member

Member

Roby

Guest

Roby

Guest

Member

Roby

Guest