Per Windows, Archivio versione 1
mega.nz
Achivio similExcel:
Vedi l'allegato 2320702
Per ora solo due voci:
1) Evidenzia, chiede di inserire fino a 15 numeri a vostro piacimento, poi a seconda delle vostre scelte, li evidenzia tutti, oppure evidenzia solo le estrazioni con 2 (oppure 3, 4, 5) numeri tra quelli che avete inserito.
Vedi l'allegato 2320703
cliccando su "Azzera evidenziazione" togliete le evidenziazioni (ma va!?)
2) File
Vedi l'allegato 2320704
Aggiungi estrazione potete usarla sia per inserire una nuova estrazione (di fatto non utilizzata perché aggiornando storico.txt si aggiorna la finestra.
Ma potete usarla per correggere eventuali errori dell'archivio. Apriamo una parente, anzi due, che poi dicono che sono avaro. L'archivio che utilizzo e corrispondente a storico.txt, identico a quello sul programma Excel, e a Visual Lotto 8 e a Spaziometria. Se ne avete un'altro che vi ispira di più potete sostituirlo.
Esporta estrazione salva una copia di archivio.txt che nel mio caso è:
Vedi l'allegato 2320705
Questa serve per aggiornare Spaziometria, usando lo Script di Ramco modificato dalla AI: (controllate che le salvi sul vostro Temp)
'Aggiorna archivio lotto di Spaziometria (Ramco)_apr2026
'Versione modificata per usare storico.txt generato da Excel
----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Sub Main
Dim sDirTemp,sFileBd
Dim sCData,nSalvate
Dim sDataEstr,sDataLastEstr
Dim nEstrTot,id,z,b
Dim aRighe,k
Dim sData,sSigla
Dim aEstr,r,c
Dim aCampi
sFileBd = GetDirectoryAppData & "BaseDati.dat"
' --- Percorso file TXT ---
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
' 2 = cartella TEMP di Windows
sDirTemp = fso.GetSpecialFolder(2) & "\storico.txt"
' --- Verifica esistenza file TXT ---
If Not fso.FileExists(sDirTemp) Then
Call Scrivi("ERRORE: il file storico.txt non esiste.",True,,,vbRed)
Call Scrivi("Generarlo prima da Excel con la macro CreaStoricoTXT.",True)
Set fso = Nothing
Exit Sub
End If
Set fso = Nothing
' --- Lettura righe del file TXT ---
ReDim aRighe(0)
If Not LeggiRigheFileDiTesto(sDirTemp,aRighe) Then
Call Scrivi("ERRORE: impossibile leggere storico.txt.",True,,,vbRed)
Exit Sub
End If
' --- Dati archivio corrente ---
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
z = Right(sDataLastEstr,4) & "/" & Mid(sDataLastEstr,4,2) & "/" & Left(sDataLastEstr,2)
id = IndiceAnnuale(nEstrTot)
b = False
' --- Loop sulle righe del file TXT ---
ReDim aEstr(11,5)
sCData = ""
For k = 0 To UBound(aRighe)
If ScriptInterrotto Then Exit For
If Trim(aRighe(k)) <> "" Then
aCampi = Split(aRighe(k),vbTab)
If UBound(aCampi) >= 6 Then
sData = Trim(aCampi(0)) ' AAAA/MM/GG
sSigla = Trim(aCampi(1))
' --- Nuova data ---
If sData <> sCData Then
If b = True Then
If sCData <> "" Then
If Left(sCData,4) <> Left(sData,4) Then id = 0
id = id + 1
sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
nSalvate = nSalvate + 1
Call Messaggio(nSalvate)
Else
ColoreTesto 2
Call Scrivi("ATTENZIONE: errore salvataggio estrazione " & sCData,True)
ColoreTesto 0
End If
End If
End If
If sCData = z Then b = True
ReDim aEstr(11,5)
sCData = sData
End If
' --- Rimappatura sigle ---
If sSigla = "BA" Then r = 1
If sSigla = "CA" Then r = 2
If sSigla = "FI" Then r = 3
If sSigla = "GE" Then r = 4
If sSigla = "MI" Then r = 5
If sSigla = "NA" Then r = 6
If sSigla = "PA" Then r = 7
If sSigla = "RM" Then r = 8
If sSigla = "TO" Then r = 9
If sSigla = "VE" Then r = 10
If sSigla = "RN" Then r = 11
' --- Numeri ---
For c = 1 To 5
aEstr(r,c) = Format2(CInt(Trim(aCampi(c + 1))))
Next
End If
End If
Call AvanzamentoElab(0,UBound(aRighe),k)
Next
' --- Salva ultima estrazione ---
If b = True Then
If sCData <> "" Then
id = id + 1
sDataEstr = Right(sCData,2) & "/" & Mid(sCData,6,2) & "/" & Left(sCData,4)
If SalvaEstrazione(aEstr,sDataEstr,id,sFileBd) Then
nSalvate = nSalvate + 1
End If
End If
End If
' --- Riepilogo ---
If nSalvate > 0 Then
AllineaArchivi
Call Scrivi()
Call Scrivi("Script per Spaziometria - Aggiornamento da file Excel",True,,,vbBlue)
Call Scrivi()
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi()
Call Scrivi("Estrazioni totali: " & EstrazioniArchivio)
Call Scrivi()
Call Scrivi("RAMCOLOTTO",True,,,vbBlue)
Else
Call Scrivi("NON HO TROVATO NUOVE ESTRAZIONI !",1,,,2)
End If
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------------------
Vedi l'allegato 2320706
Vedi l'allegato 2320707
Piano, piano porterò avanti il programmino, aggiungendo, se possibile, un po' di colore. Una parte Ricerca e non so cos'altro. Se avete suggerimenti illuminatemi (tranquilli non vi mando la bolletta!) Segnalate errori, orrori, capre e elefanti.
