Novità

per LUIGI , aggiornamento spaziometria

vincenzo4221

Advanced Member >PLATINUM<
NON ricordo e non trovo la discussione dove hai allegato questo tuo script che aggiornava spaziometria , non mi ricordo i passaggi necessari, ma funzionava, (alla stregua di altri aggiornamenti ad esempio evidenze.xls, ricordi?) finora utilizzavo l'aggiornamento manuale , ma ora sono rimasto un pò indietro.
Option Explicit
Sub Main
Dim xlApp ' oggetto excel
Dim xlBook ' insieme di cartelle di lavoro
Dim xlSheet ' foglio di lavoro
Dim sFileXls
Dim sLastData
Dim idEstr,k,r,nLastRiga,nAggiornate
Dim aNum

sFileXls = ScegliFile("",".xls")
If FileEsistente(sFileXls) Then
If OpenExcelFile(xlApp,xlBook,xlSheet,sFileXls)Then
sLastData = GetUltimaDataIns(xlSheet,nLastRiga)
If IsDate(sLastData) Then
idEstr = DataEstrToIdEstr(Day(sLastData),Month(sLastData),Year(sLastData))
If idEstr <> 0 Then
For k = idEstr + 1 To EstrazioniArchivio
nLastRiga = nLastRiga + 1

Messaggio DataEstrazione(k)
DoEventsEx
If ScriptInterrotto Then Exit For
xlSheet.cells(nLastRiga,1) = IndiceAnnuale(k) & "-" & DataEstrazione(k,,,"/")
For r = 1 To 11
If r = 11 Then
Call GetArrayNumeriRuota(k,12,aNum)
Else
Call GetArrayNumeriRuota(k,r,aNum)

End If
xlSheet.cells(nLastRiga,r + 1) = FormattaNumeri(aNum)
Next
nAggiornate = nAggiornate + 1

Next
If nAggiornate > 0 Then
MsgBox "Aggiornate " & nAggiornate & "estrazioni." & vbCrLf & "Chudere il file excel salvando le modifiche e riaprirlo"
End If
Else
MsgBox "Con la data " & sLastData & " non è stata trovata l'estrazione nell'archivio del programma"
End If
Else
MsgBox sLastData & " data non riconosciuta"
End If
Else
MsgBox "Errore apertura foglio excel",vbCritical
End If



xlApp.visible = True
' da fare alla fine della scrittura del foglio per liberare risorse
'xlSheet.save
'xlBook.Close
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
Function OpenExcelFile(xlApp,xlBook,xlSheet,sFile)
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open(sFile)
Set xlBook = xlApp.Workbooks(1)
Set xlSheet = xlBook.Sheets("Estrazioni")
If Err = 0 Then
OpenExcelFile = True
End If

End Function

Function GetUltimaDataIns(xlSheet,nLastRiga)
Dim k,j
Dim sData

nLastRiga = 0
Messaggio("Cerca ultima data ..")

k = 3
Do While xlSheet.cells(k,1) <> ""
k = k + 20
Loop
For j = k To 3 Step - 1
If xlSheet.cells(j,1) <> "" Then
sData = xlSheet.cells(j,1)
nLastRiga = j
Exit For
End If
Next

If sData <> "" Then
Dim aV
aV = Split(sData,"-")
GetUltimaDataIns = Trim(aV(1))
Else
GetUltimaDataIns = ""
End If
End Function

Function FormattaNumeri(aNum)
Dim k
Dim sRet

sRet = ""
For k = 1 To 5
sRet = sRet & FormatSpace(aNum(k),2,True) & " "
Next

FormattaNumeri = Trim(sRet)
End Function
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 16 ottobre 2025
    Bari
    03
    66
    37
    18
    61
    Cagliari
    26
    22
    85
    20
    43
    Firenze
    29
    61
    85
    67
    75
    Genova
    40
    63
    74
    19
    78
    Milano
    43
    80
    34
    54
    70
    Napoli
    18
    78
    89
    15
    27
    Palermo
    38
    84
    88
    06
    62
    Roma
    60
    14
    40
    84
    43
    Torino
    51
    62
    58
    65
    52
    Venezia
    07
    61
    48
    63
    87
    Nazionale
    60
    36
    11
    28
    31
    Estrazione Simbolotto
    29
    02
    24
    03
    37
Indietro
Alto