Ordonner des tirages de l'euromillions

[patogaz]

Bonjour,

Voici mon problème, sous excel 2003, je dispose d'un fichier "base" contenant par exemples les tirages de l'euromillions et je souhaite redisposer par exemple les 30 derniers tirages, automatiquement dans un autre fichier qui s'enregistrera sous le nom "Graphique_20110121" qui doit correspondre à la date du dernier tirage.

J'ai joint les deux fichiers et dans "graphique_20110121", j'ai commencé à remplir manuellement quelques tirages pour vous montrer ce que je souhaite obtenir.

Je vous remercie d'avance de votre attention.
Cordialement

 

[KenDev]

Re : Ordonner des tirages de l'euromillions

Bonjour Patogaz,

Voici un code qui réalise les fonctions demandées. Écrit sous Excel 2007 mais qui devrait fonctionner sous 2003. J'ai juste un doute pour certaines lignes de la partie format mais en ce cas ce sera facile de les modifier voire de les supprimer puisque cela ne concerne que de la mise en forme. Cordialement.

Option Explicit

Sub NDerTir()
    
Dim vLDat As Long 'date du dernier tirage
Dim vLNTr As Long 'nombre de tirages demandés
Dim vLNEn As Long  'nombre d'enregistrements dans la base
Dim oWsE As Worksheet 'feuille euromillions
Dim oWsR As Worksheet 'feuille résultat temporaire
Dim oWbB As Workbook 'classeur base
Dim oWbG As Workbook 'classeur graphique
Dim i As Long
Dim j As Long
Dim k As Byte

'Paramètres
    Set oWbB = ThisWorkbook
    Set oWsE = ActiveSheet
    vLDat = Cells(2, 1).Value
    vLNTr = Application.InputBox(prompt:="Combien de tirages souhaités ?", Type:=1, Default:=30)
    vLNEn = Cells(Rows.Count, 1).End(xlUp).Row - 1
    'contrôles cohérences
    If vLNTr = 0 Then Exit Sub 'si on a cliquer sur Annuler
    If vLNTr > Columns.Count - 1 Then
        MsgBox "Pas assez de colonnes disponibles, fin"
        Exit Sub
    End If
    If vLNTr > vLNEn Then
        MsgBox "Pas assez de tirages disponibles, fin"
        Exit Sub
    End If
    'ajout feuille
    Sheets.Add
    Set oWsR = ActiveSheet
    
'Remplissage feuille graphique
    For i = 1 To 50 'pour chaque boule existante
        For j = 1 To vLNTr 'pour chaque tirage
            For k = 1 To 5 'pour chaque boule tirée
                If oWsE.Cells(vLNTr + 2 - j, k + 1) = i Then
                    Cells(i + 1, j + 1) = i
                End If
            Next k
        Next j
    Next i

'Nouveau classeur et copie
    Cells.Select
    Selection.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
     
'Formatage feuille graphique
    'écriture colonne 1
    For i = 1 To 50
        Cells(i + 1, 1) = i
    Next i
    'écriture ligne 1
    For i = 1 To vLNTr
        Cells(1, i + 1) = oWsE.Cells(vLNTr + 2 - i, 1)
    Next i
    'police
    Columns(1).Font.FontStyle = "Bold"
    Cells.Font.Size = 10
    'orientation
    Rows(1).Orientation = 90
    'ajustement
    Rows(1).AutoFit
    For i = 1 To vLNTr + 1
        Cells(1, i).EntireColumn.AutoFit
    Next i
    'figer les volets
    Rows(2).Select
    ActiveWindow.FreezePanes = True
    'suppression feuilles superflues
    Application.DisplayAlerts = False
    Worksheets("Feuil2").Delete
    Worksheets("Feuil3").Delete
    Application.DisplayAlerts = True
    
    'sauvegarde
    ActiveWorkbook.SaveAs Filename:="Graphique_" & vLDat & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    Set oWbG = ThisWorkbook
    
    'suppression feuille temporaire dans classeur base
    oWbB.Activate
    Application.DisplayAlerts = False
    oWsR.Delete
    Application.DisplayAlerts = True
    
    'libération des objets
    Set oWsE = Nothing
    Set oWsR = Nothing
    Set oWbB = Nothing
    Set oWbG = Nothing
End Sub

 

[soenda]

Re : Ordonner des tirages de l'euromillions

Bonsoir le fil, patogaz
Bonsoir KenDev

Oups !
J'arrive un peu tard

A plus

 

[patogaz]

Re : Ordonner des tirages de l'euromillions

Bonjour Kendev, Bonjour Soenda,

Merci beaucoup de votre attention et Kendev, ç'est géant !!!
En lisant ton code, cela me parait fort "facile" mais je galérais, je dirai plus je faisais du surplace.
Je vais décortiquer tranquillement cela.
A+

Merci encore