CROISEZ LES TIRAGES DE EURO MILLIONS AVEC VOS GRILLES V2 UPDATE
cs_vladam
Messages postés
216
Date d'inscription
dimanche 13 janvier 2002
Statut
Modérateur
Dernière intervention
7 novembre 2009
-
24 juil. 2005 à 20:23
Ouggada Messages postés 38 Date d'inscription dimanche 24 décembre 2000 Statut Membre Dernière intervention 4 mars 2009 - 18 févr. 2009 à 13:15
Ouggada Messages postés 38 Date d'inscription dimanche 24 décembre 2000 Statut Membre Dernière intervention 4 mars 2009 - 18 févr. 2009 à 13:15
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/32865-croisez-les-tirages-de-euro-millions-avec-vos-grilles-v2-update
https://codes-sources.commentcamarche.net/source/32865-croisez-les-tirages-de-euro-millions-avec-vos-grilles-v2-update
18 févr. 2009 à 13:15
je pense que mon padre va être refait....!!
6 mars 2006 à 18:48
8 août 2005 à 11:17
Merci et bonne continuation !
26 juil. 2005 à 20:10
j'ai ici encore une sub pour télécharger les tirages (avec les gains ...) de www.fdjeux.com
Dans mon projet, j'insère les nouveaux tirages dans une base access.
Le seul hic, c'est que le fichier à télécharger est un ZIP, j'ai trouvé un ocx libre sous http://www.codeguru.com/vb/gen/vb_graphics/fileformats/article.php/c6743/, mais je n'ai pas testé sous .net!
Const Proxy As String = "192.168.1.11:3128"
Const DNS As String = "192.168.114.252"
Const UrlGetZip = "http://www.fdjeux.com/generated/dyn/euromillions/euromillions.zip"
Public Sub UpdateDatabase()
Dim fso As New FileSystemObject
Dim ts As TextStream
Dim line As String
Dim a() As String
Dim oUnZip As New CGUnzipFiles
Dim Count As Long
Dim inet1 As Object
Dim rstTirages As New ADODB.Recordset
Dim rstRapports As New ADODB.Recordset
Application.StatusBar = "Downloading from " & UrlGetZip
' open our database, in the same path than the application
If Trim$(cnn.ConnectionString) = "" Then
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\Euromillions.mdb"
End If
Set inet1 = CreateObject("InetCtls.Inet")
inet1.Proxy = Proxy
Dim bData() As Byte
bData() = inet1.OpenURL(UrlGetZip, 1)
Open ActiveWorkbook.Path & "" & "tmp.zip" For Binary Access Write As #1
Put #1, , bData()
Close
Application.StatusBar = "Unzipping " & ActiveWorkbook.Path & "" & "tmp.zip" & vbCrLf
oUnZip.ZipFileName = ActiveWorkbook.Path & "" & "tmp.zip"
oUnZip.ExtractDir = ActiveWorkbook.Path ' or whatever you like !
If oUnZip.Unzip <> 0 Then
MsgBox oUnZip.GetLastMessage
End If
Set oUnZip = Nothing
Count = 0
Application.StatusBar = "Importing " & ActiveWorkbook.Path & "" & "Euromill.csv" & vbCrLf
Set ts = fso.OpenTextFile(ActiveWorkbook.Path & "" & "Euromill.csv", ForReading)
line = ts.ReadLine
If line <> "annee_numero_de_tirage;jour_de_tirage;date_de_tirage;" & _
"date_de_forclusion;boule_1;boule_2;boule_3;boule_4;" & _
"boule_5;etoile_1;etoile_2;boules_gagnantes_en_ordre_croissant;" & _
"etoiles_gagnantes_en_ordre_croissant;" & _
"nombre_de_gagnant_au_rang1_en_france;nombre_de_gagnant_au_rang1_en_europe;rapport_du_rang1;" & _
"nombre_de_gagnant_au_rang2_en_france;nombre_de_gagnant_au_rang2_en_europe;rapport_du_rang2;" & _
"nombre_de_gagnant_au_rang3_en_france;nombre_de_gagnant_au_rang3_en_europe;rapport_du_rang3;" & _
"nombre_de_gagnant_au_rang4_en_france;nombre_de_gagnant_au_rang4_en_europe;rapport_du_rang4;" & _
"nombre_de_gagnant_au_rang5_en_france;nombre_de_gagnant_au_rang5_en_europe;rapport_du_rang5;" & _
"nombre_de_gagnant_au_rang6_en_france;nombre_de_gagnant_au_rang6_en_europe;rapport_du_rang6;" & _
"nombre_de_gagnant_au_rang7_en_france;nombre_de_gagnant_au_rang7_en_europe;rapport_du_rang7;" & _
"nombre_de_gagnant_au_rang8_en_france;nombre_de_gagnant_au_rang8_en_europe;rapport_du_rang8;" & _
"nombre_de_gagnant_au_rang9_en_france;nombre_de_gagnant_au_rang9_en_europe;rapport_du_rang9;" & _
"nombre_de_gagnant_au_rang10_en_france;nombre_de_gagnant_au_rang10_en_europe;rapport_du_rang10;" & _
"nombre_de_gagnant_au_rang11_en_france;nombre_de_gagnant_au_rang11_en_europe;rapport_du_rang11;" & _
"nombre_de_gagnant_au_rang12_en_france;nombre_de_gagnant_au_rang12_en_europe;rapport_du_rang12;" Then
MsgBox "File format changed! Abording..." & ActiveWorkbook.Path & "" & "Euromill.csv"
Else
Do While Not ts.AtEndOfStream
line = ts.ReadLine
a = Split(line, ";")
' check the tirages table
rstTirages.Open "SELECT * FROM Tirages Where Tirage=" & a(0), cnn, adOpenDynamic, adLockOptimistic
If rstTirages.EOF Then
Count = Count + 1
' add this one
Application.StatusBar = "Adding TIRAGE " & a(0) & " date " & a(2)
rstTirages.Close
rstTirages.Open "Tirages", cnn, adOpenDynamic, adLockOptimistic
rstTirages.AddNew
rstTirages.Fields("Tirage") = Val(a(0))
rstTirages.Fields("Date") = #1/1/1000#
rstTirages.Fields("Date") = DateAdd("d", CDbl(Mid(a(2), 7, 2)) - 1, rstTirages.Fields("Date"))
rstTirages.Fields("Date") = DateAdd("m", CDbl(Mid(a(2), 5, 2)) - 1, rstTirages.Fields("Date"))
rstTirages.Fields("Date") = DateAdd("yyyy", CDbl(Mid(a(2), 1, 4)) - 1000, rstTirages.Fields("Date"))
rstTirages.Fields("B1") = Val(a(4))
rstTirages.Fields("B2") = Val(a(5))
rstTirages.Fields("B3") = Val(a(6))
rstTirages.Fields("B4") = Val(a(7))
rstTirages.Fields("B5") = Val(a(8))
rstTirages.Fields("E1") = Val(a(9))
rstTirages.Fields("E2") = Val(a(10))
rstTirages.Update
End If
rstTirages.Close
' check the rapports table
rstRapports.Open "SELECT * FROM Rapports Where Tirage=" & a(0), cnn, adOpenDynamic, adLockOptimistic
If rstRapports.EOF Then
' add this one
Application.StatusBar = "Adding RAPPORTS " & a(0) & " date " & a(2)
rstRapports.Close
rstRapports.Open "Rapports", cnn, adOpenDynamic, adLockOptimistic
rstRapports.AddNew
rstRapports.Fields("Tirage") = Val(a(0))
rstRapports.Fields("Date") = #1/1/1000#
rstRapports.Fields("Date") = DateAdd("d", CDbl(Mid(a(2), 7, 2)) - 1, rstRapports.Fields("Date"))
rstRapports.Fields("Date") = DateAdd("m", CDbl(Mid(a(2), 5, 2)) - 1, rstRapports.Fields("Date"))
rstRapports.Fields("Date") = DateAdd("yyyy", CDbl(Mid(a(2), 1, 4)) - 1000, rstRapports.Fields("Date"))
rstRapports.Fields("nbrR1") = Val(a(14))
rstRapports.Fields("rapR1") = Val(a(15))
rstRapports.Fields("nbrR2") = Val(a(17))
rstRapports.Fields("rapR2") = Val(a(18))
rstRapports.Fields("nbrR3") = Val(a(20))
rstRapports.Fields("rapR3") = Val(a(21))
rstRapports.Fields("nbrR4") = Val(a(23))
rstRapports.Fields("rapR4") = Val(a(24))
rstRapports.Fields("nbrR5") = Val(a(26))
rstRapports.Fields("rapR5") = Val(a(27))
rstRapports.Fields("nbrR6") = Val(a(29))
rstRapports.Fields("rapR6") = Val(a(30))
rstRapports.Fields("nbrR7") = Val(a(32))
rstRapports.Fields("rapR7") = Val(a(33))
rstRapports.Fields("nbrR8") = Val(a(35))
rstRapports.Fields("rapR8") = Val(a(36))
rstRapports.Fields("nbrR9") = Val(a(38))
rstRapports.Fields("rapR9") = Val(a(39))
rstRapports.Fields("nbrR10") = Val(a(41))
rstRapports.Fields("rapR10") = Val(a(42))
rstRapports.Fields("nbrR11") = Val(a(44))
rstRapports.Fields("rapR11") = Val(a(45))
rstRapports.Fields("nbrR12") = Val(a(47))
rstRapports.Fields("rapR12") = Val(a(48))
rstRapports.Update
End If
rstRapports.Close
Loop
Application.StatusBar = "Import done, " & CStr(Count) & " new tirages."
End If
rstTirages.Close
rstRapports.Close
End Sub
25 juil. 2005 à 03:15
24 juil. 2005 à 23:00
j'avais un peu de temps ;)
Je pourrais l'améliorer bien plus genre :
Comme la source de lotobase trouvable sur mon site :
claudetom.fr.st rubrique programmation.
récupération des tirages directement sur internet.
Affichage d'une liste des tirages depuis ce jour avec tri sélectif.
Possibilité de multiliste (exemple si plusieurs personnes jouent dans la même maison).
Affichage des numéros les plus souvent sortis.
Comparaison des grilles jouées sur tous les tirages déjà sortis.
Aperçu des numéros les plus souvent sortis en graphe et dans une grille.
Mis en avant des numéros ou tirage avec les sommes perdues et gagnantes configurable.
etc..
Mais je manque de temps beaucoup de boulot.
Donc si des personnes débutantes ou pros sont intéressées à vos claviers.
le chalenge faire un logiciel pro, entièrement gratuit ou tout le monde y mets sa signature et son petit +
Je n'ai aucun mérite juste ma participation pour le plaisir.
Comme je l'ai, déjà fais avec des personnes de ce groupe, ils me connaissent et je les respecte.
À plusieurs ont fait avancer et évoluer les choses.
Ici c'est l'entraide qui prône donc faisons le nécessaire :)
Et c'est grâce à ce site que moi-même j'évolue dans la connaissance de ce langage.
ClaudeTom
24 juil. 2005 à 20:23