10 e lotto ogni 5 minuti

[avatar]

ecco la versione intelligente dello script , capisce da solo quale è il range orario
vede qual'è l'ultima estrazione e propone al giocatore la scelta se aggiornare
daccapo o accodare.
Come fa lo script a capire quale range orario viene usato nel foglio ? Semplice
legge le prime estrazioni dell'archivio fino a rottura del valore indicegiornaliero
quindi è essenziale che almeno la prima sequenza di estrazioni relativa al primo
giorno dell'archivio ci sia tutta, non mi pare sia un problema bastera usare un foglio che appunto.
gia contiene estrazioni ed è il caso nostro.

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.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

ciao solare ciao strupi per creare gli archivi bisogna usare questa macro con spaziometria
creata dal bravissimo luigib

apri il foglio posizionalo su archivio e lancia lo script con spaziometria

e puoi creare un range di estrazioni

usate un range di estrazione max 10000 estrazioni

 

[avatar]

ore 19 45 ore 20 45

ambata 77 giocare su queste 3 ore 19 50 20:00 20:35
ambata 56 giocare su queste 2 ore 20:00 20:45

terno 44 77 56
terno 56 35 67

 

[Roby]

Ciao sono passato solo per un minuto, perchè devo scappare
avatar fammi una cortesia che come un cog.... ho cancellato il programma spiamo i giorni x il 6 e vuotato il cestino senza salvarmi il file zip (santa pazienza) se puoi,
anche se sto ancora studiando a fondo spiamo i giornil x le terzine.

x oggi ci sono tre previsioni non ottimali statisticamente ma proviamo a vedere che succede

1° dalle 16,35 alle 17,35 = 38-10-7 secco secco (migliore)

2° dalle 20,50 alle 21,50 = 51-38-86 / 51-38-35 chi vuole può fare la quartina, secondo me potrebbe uscire solo il terno

3° dalle 21,20 alle 22,20 = 62-38-87-41 secca

vi saluto devo andare
questa sera devo cucinare quindi ci sentiamo o molto tardi o domani
BUINI PRONOSTICI A TUTTI

BRAVISSIMO ORE 20,50 estr.190 Terno in terzina 51.38.35 Complimenti Rol65 !!!!

 

[Roby]

Ciao Slottina grazie, cena rinviata quindi sono libero di studiare le terzine fino a tarda notte.
Avatar controlla la posta
ciao

 

[solare]

Grazie avatar

 

[avatar]

ciao rol ti ho risposto vado un po a riposare gli occhi

ciao solare

 

[solare]

Ciao Avatar, a me non funziona l'aggiornamento dell'archivio
ho office 2007.

 

[avatar]

lo stesso problema lo aveva keeper a installato office 2003 e va bene

devi installare office 2003

 

[keeper]

si installa la 2003 funziona io avevo molti problemi prima con 2010 poi con 2007
allora le previsioni come sono andate?

 

[Roby]

Ciao sono passato solo per un minuto, perchè devo scappare
avatar fammi una cortesia che come un cog.... ho cancellato il programma spiamo i giorni x il 6 e vuotato il cestino senza salvarmi il file zip (santa pazienza) se puoi,
anche se sto ancora studiando a fondo spiamo i giornil x le terzine.

x oggi ci sono tre previsioni non ottimali statisticamente ma proviamo a vedere che succede

1° dalle 16,35 alle 17,35 = 38-10-7 secco secco (migliore)

2° dalle 20,50 alle 21,50 = 51-38-86 / 51-38-35 chi vuole può fare la quartina, secondo me potrebbe uscire solo il terno

3° dalle 21,20 alle 22,20 = 62-38-87-41 secca

vi saluto devo andare
questa sera devo cucinare quindi ci sentiamo o molto tardi o domani
BUINI PRONOSTICI A TUTTI

Ciao keeper poteva andare peggio
1° solo due due
2° 5 due e terno 51-38-35
3° 3 due

 

[Roby]

Avatar controlla la posta

per oggi 25 agosto 2012

dalle 10,45 alle 11,45 = 89-47-44 / 89-47-65 Statisticamente ottima ci potrebbe scappare anche la quaterna 89-47-44-65

delle 15,45 alle 16,45 = 69-62-4 / 69-62-11 Statisticamente ottima solo x terno

caso raro avere due ottime vediamo che succede.

Ciao a tutti

 

[Roby]

ore 19 45 ore 20 45

ambata 77 giocare su queste 3 ore 19 50 20:00 20:35
ambata 56 giocare su queste 2 ore 20:00 20:45

terno 44 77 56
terno 56 35 67

Provate a controllare queste giocate
Grazie avatar, desideri e rocco state facendo un capolavoro.

 

[avatar]

ciao rol stai svolgento un bel lavoro anche tu

 

[avatar]

Mt. Cattura ambata ,ambo ,terno

Mt. Cattura ambata ,ambo ,terno

Ore 9 ore 10

ambata 71 ore 9:20 9:30 9:50 10:00
ambata 33 ore 9:20 9:40 10:00
ambata 54 ore 9:15 9:25
ambata 72 ore 9:00 9:05 9:45 9:55
ambata 49 ore 9:15 9:25 10:00
ambata 11 ore 9:00 10:00
ambata 29 ore 9:00 9:50
ambata 56 ore 9:15 9:45
ambata 55 ore 9:40 10:00
ambata 03 ore 9:00 9:05 9:50
ambata 83 ore 9:15 9:25

cattura ambi e terni

ambo 71 33 9:20 10:00
terno 71 33 55 9:20 9:40 10:00
terno 03 49 54 9:15 9:25
ambo 33 55 9 :40 10:00
ambo 3 29 9:00 9: 50

 

[solare]

Ciao Avatar, ho installato excel 2003, il foglio si apre tranquillamente, però non parte l'aggiornamento delle estrazioni
avviando lo script mi chiede se voglio aggiornare o no, alla risposta si non aggiorna, forse sbaglio qualcosa ?
NB: ho aperto il foglio, vado su spia e poi a sx casella arch e a dx imposta archivio le ho provate tutte e due aprendole prima di avviare lo script ma niente.
Si può fare diversamente ?
Grazie

 

[keeper]

devi avere aperto solo il foglio archivio e non arch

 

[keeper]

non devi fare niente di quello che hai scritto dopo aver lasciato lo script la prima opzione ti chiede se vuoi aggionrare l'archivio di spaziometria poi ti dice di avere aperto il foglio archivio e tu premi si poi se individua il foglio aperto alora apparirà la casella delle fasce orarie

 

[solare]

Grazie keeper

 

[avatar]

ciao solare e come a detto keeper

per selezionare un range premi si poi al secondo passaggio no poi selezioni l ora e consigliabile sempre 3 ore

 

[avatar]

Ore 9 ore 10
ambata 71 ore 9:20 9:30 9:50 10:00
ambata 33 ore 9:20 9:40 10:00
ambata 54 ore 9:15 9:25
ambata 72 ore 9:00 9:05 9:45 9:55
ambata 49 ore 9:15 9:25 10:00
ambata 11 ore 9:00 10:00
ambata 29 ore 9:00 9:50
ambata 56 ore 9:15 9:45
ambata 55 ore 9:40 10:00
ambata 03 ore 9:00 9:05 9:50
ambata 83 ore 9:15 9:25

cattura ambi e terni

ambo 71 33 9:20 10:00
terno 71 33 55 9:20 9:40 10:00
terno 03 49 54 9:15 9:25
ambo 33 55 9 :40 10:00
ambo 3 29 9:00 9: 50

affondate 6 ambate