Spaziometria nuova versione

[firefox]

Buonasera a tutto voi

faccio notare che all'indirizzo fornito per il download di spaziometria viene fuori questo:
[h=3]Invalid or Deleted File.[/h] The key you provided for file download was invalid. This is usually caused because the file is no longer stored on MediaFire. This occurs when the file is removed by the originating user or MediaFire.
Still have questions or do you think we've made an mistake? Check our knowledge base for more information or contact us about it.

Buon anno a tutti voi

 

[LuigiB]

ora è risolto
nella nuova versione è presente una nuova plugin fornita da rubino per le statistiche sulle fascie di ritardo.
buon anno a tutti

 

[rabberto]

Grazie sig. LuigiB buon anno anche a te e tutto il forum , ciao.

 

[pgioy]

buona sera
LuigiB volevo chiederle se le risulta con il file " AggSpie10L5M.exe" ho provato con
sia con la 98-99 ma non va piu ,va in errore con win7
grazie
buon anno

 

[LuigiB]

ciao , a me sembra che funzioni , lo spero perche non trovo piu lo script che era servito per creare l'eseguibile e quindi non posso ricomplilarlo

 

[keeper]

eccolo credo sia questo

Option ExplicitDim 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

 

[pgioy]

grazie keeper
molto gentile ok funziona da solo un errore
nella prima frase "Option ExplicitDim xlApp ' oggetto excel"
l'ho corretta e va ok.
buon anno

 

[keeper]

modificalo così
Option Explicit
Dim xlApp ' oggetto excel

 

[LuigiB]

Rubino mi ha informato di un errore che avevo commesso nel trasformare il suo script in un plugin , quindi l'ho aggiornato
inoltre sono state fatte delle altre piccole modifiche internamente.
buon anno a tutti !!

 

[miki55]

Ciao Gigi. Volevo chiederti ancora una cortesia, quando hai un pò di tempo se nella cartella "FAMIGLIA DI AMBI"
potresti aggiungere tutti e 90 gli "ambi di somma" per verificare, quando sortiscono uniti, il tempo ci mettono per disunirsi come d'estratto.
L'occasione è gradita per augurarti un 2013 carico di qualsiasi fortuna, insieme ai familiari, e una grazie sincero anche da parte mia per tutto quello che fai.
AUGURI

 

[LuigiB]

chwe cosa sono gli ambi di somma ?

 

[miki55]

chwe cosa sono gli ambi di somma ?

ciao Gigi, allego l'immagine della ricerca degli AMBI di SOMMA 1, come esempio. Sò che è poco, ma se qualcuno
può aiutarci con uno script, fornendoci l'elenco completo, farebbe cosa gradita.
Esso servirà per poterlo allegare in Spaziomatria, come nuova ricerca utile a tutti.
Colgo l'occasione per augurarvi un buon 2013 a l'intero forum e grazie per l'eventuale disponibilità.

[/URL][/IMG]

 

[LuigiB]

ciao Miki , buon 2013 .. a te e a tutti .. non c'è bisogno di nessun elenco li calcola automaticamente .. quello che non ho capito è se devono far parte tutti della stessa famiglia ...cioe gli ambi di somma 1 ,gli ambi di somma 2 , quelli di somma 3 e compagnia bella fanno capo tutti alla stessa famiglia ? fino a che somma devono arrvare ?

 

[miki55]

Confermo, tutte fino alla "somma 90", serve per conoscere specie quelli uniti, nel tab anal in loro rit minimo,
per poi sapere, tra i due, quale preferire all'estratto determ
Nell'attesa, ti rinnovo gli auguri...

 

[LuigiB]

scusa se tutti gli ambi appartengono alla stessa famiglia senza differenziarli per somma escono fuori tutti e 4005 gli ambi o sbaglio ?
sei sicuro che non volevi dire di inserire le 90 famiglie differenti degli ambi ? Quelli di somma 1 , quelli di somma 2 e cosi via ?

 

[miki55]

ciao Luigi, ecco esposto il calcolo di tutte le somme degli ambi...

[/URL][/IMG]

 

[LuigiB]

non ci siamo capiti .. io avevo chiesto se tali ambi dovessero far parte tutti della stessa unica famiglia e mi avevi detto di si , invece vanno create altre 90 righe per selezionare le famiglie (90 somme 90 famiglie diverse)

Ambi di somma 1
Ambi di somma 2
Ambi di somma 3
..
..
Ambi di somma 90

 

[miki55]

Confermo devono far parte della stessa famiglia. Per famiglia di ambi intendo 45 della stessa somma
Ambi di somma 1 solo questi
Ambi di somma 2 solo questi
Ambi di somma 3 solo questi
ecc. ecc.

..

 

[Tot42]

Buona sera a tutte ed a tutti i frequentatori di questo forum e TANTISSIMI AUGURI DI UN BUON 2013, un saluto particolare va a LuigiB, realizzatore dell'ottimo programma spaziomatria
che ho seguito sin dal primo post, per l'abnegazione, la disponibilità verso tutti coloro che gli chiedono consigli esuggerimenti e non vorrei dilungarmi nei complimenti oltre quelli che
gli vengono fatti e che merita ampiamente. Sono un pensionato, utilizzo il programma più che altro come passatempo, e qualche volta gioco pure una o due bollette al lotto.
a LuigiB vorrei chiedere un favore. nell'usare il programma con gli archivi paralleli L1 L2 L3 L4 L5 trovo difficoltà nel cercare i numeri reali corrispondenti a quelli degli archivi paralleli,
che sino alla versione 1.3.76 trovavo facilmente con il magnifico script di corrispondenza dei numeri che ha realizzato, non ricordo per chi, adesso, invece, a parte l'archivio L1 delle
posizioni di ritardo che posso rintracciare tramite le posizioni di ritardo nella'archivio reale per gli altri archivi non saprei da dove ricavarli, anche se, ottimamente, su quegli archivi, inserendoli,
si riescono a fare tutte le ricerche e le statistiche possibili ed immaginabili, purtroppo adesso le funzioni nReale = NumParToNumReale(k,Ruota,idEstr,idArchivio) e
nTmpPadre = NumParToNumPadre(numPadre,Ruota,idEstr,j) restituiscono 0, ringrazio vivamente se ti puoi occupare della risoluzione di
questo problema e, nel rinnovare gli auguri di Buon Anno vi giungano anche i più cordiali saluti. Toty
P.S. frequento il forum solo come osservatore, perchè mi sono ripromesso di non partecipare a nessuna discussione, per motivi miei
personale e non avrei voluto scrivere neanche questo messaggio; ma facendomi coraggio con l'occassione della festività, ho voluto osare.

 

[LuigiB]

Ciao Tot42 , hai fatto bene ad avvertirmi , il problema dovrebbe essere risolto con questo nuovo aggiornamento.
Ora le ferie son finite e la versione 1.4.1 penso che a meno di errori rimarra per parecchio tempo.
Auguri di buon anno a tutti !