Option Explicit

' ======================================================================
' =                                 TIRAGE 1ere Partie TRIPLETTES                                                          =
' ======================================================================
Sub Triplettes()

    Dim i As Long
    Dim Y As Long
        
        ' On appelle la procédure Tirage Equipes
        Tirage 3

        Y = 1
        Pl = 3

        With Worksheets("Concours")    ' 000000000000000000   Mettre un point d'arrêt  00000000000000000000000000000000000000000000000000
        
            For i = 2 To Sheets("Inscriptions").Cells(Rows.Count, "N").End(xlUp).Row Step 2
            
                .Cells(Pl + Y, "A") = Sheets("Inscriptions").Range("N" & i)
                .Cells(Pl + Y, "B") = Sheets("Inscriptions").Range("O" & i)
                .Cells(Pl + Y + 1, "B") = Sheets("Inscriptions").Range("P" & i)
                .Cells(Pl + Y + 2, "B") = Sheets("Inscriptions").Range("Q" & i)
                       
                Y = Y + 4
                
            Next i
                
            Y = 1
                
            For i = 3 To Sheets("Inscriptions").Cells(Rows.Count, "O").End(xlUp).Row Step 2  ' Lit la liste colonne "O"
                 
                .Cells(Pl + Y, "E") = Sheets("Inscriptions").Range("N" & i)
                .Cells(Pl + Y, "F") = Sheets("Inscriptions").Range("O" & i)
                .Cells(Pl + Y + 1, "F") = Sheets("Inscriptions").Range("P" & i)
                .Cells(Pl + Y + 2, "F") = Sheets("Inscriptions").Range("P" & i)
                        
                Y = Y + 4
                
            Next i
                
            Dl = .Cells(Rows.Count, "A").End(xlUp).Row
            Range("Dl_1") = Dl
                
            Call M_7EnteteEtGrilles.Entete
            Call M_7EnteteEtGrilles.Grille1Triplette
                           
            .Range("J1") = "En cours"
                
            With .Shapes.Range(Array("Button 1"))
            
                .Left = Cells(Dl, "i").Left 'Y
                .Top = Cells(Dl, "i").Top 'Z
                .TextFrame.Characters.Text = "Tirage " & Chr(10) & "2e partie" & Chr(10) & "Triplette"
                
            End With
                

'           .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        
        End With

Application.ScreenUpdating = True

End Sub



' ======================================================================
' =                                        TIRAGE 2eme Partie TRIPLETTES                                                =
' ======================================================================

Sub GagnantsConcoursTriplette_2eP() ' Tirage 1ere partie concours

        Dim Cl As Range
        Dim Xa As Integer, Xc As Integer
        'Dim Ya As Integer, Yc As Integer
        Dim X As Integer
        Dim Y As Integer
        Dim Z As Integer
        'Dim Dl2 As Integer
        Dim Nb_Lignes As Integer
        Dim i As Long
        
        Application.ScreenUpdating = False

        With Worksheets("Concours")
        
            'Pl = 4
            Dl = .Cells(Rows.Count, "A").End(xlUp).Row
            Xa = Application.WorksheetFunction.CountA(.Range("A4:A" & Dl))
            Xc = Application.WorksheetFunction.CountA(.Range("C4:C" & Dl))
                
            If Xa <> Xc Then
            
                    MsgBox "Il semble que tous les résultats ne soient pas saisis !", vbExclamation, "Il manque les résultats de " & Xa - Xc & " équipes /" & Xa & " !"
                    Exit Sub
                    
            End If
            
            .Unprotect
                
            'For X = Pl To Dl Step 3
            For X = 4 To Dl Step 3
            
                    .Range("C" & X & ":C" & X + 2).Locked = True
                    .Range("G" & X & ":G" & X + 2).Locked = True
                    X = X + 1
                    
            Next X
            
            If .Cells(Dl, "F") = "" Then .Range("E" & Dl & ":E" & Dl + 2).ClearContents
                
                X = Application.WorksheetFunction.CountA(.Range("C" & .Range("Pl_" & Partie).Value & ":C" & Dl + 1))
                
                If X > 0 Then
                
                        MsgBox "Il y a déja des gagnants inscrit en 2e Partie. Impossible de continuer."
                        
                End If
                
                ' efface la plage "AF1:AFx" et "AH1:AHx" ou sont tirés au sort les équipes gagnantes et perdanres
                Dl = .Cells(Rows.Count, "AF").End(xlUp).Row + 2
                
                .Range("AF1:AF" & Dl).ClearContents
                .Range("AH1:AH" & Dl).ClearContents
                
                ' Derniere ligne de la colonne A une 2e fois car le champ 2e Partie a été effacé
                Dl = .Cells(Rows.Count, "A").End(xlUp).Row
                
                X = 1
                AleTri = 32                             ' numéro de la colonne Gagnants
                
                For Z = 4 To Dl Step 4
                
                        ' Recherche la lettre "G" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des gagnants "AG"
                        If .Range("C" & Z) = "G" Then .Cells(X, AleTri) = .Cells(Z, "A").Value
                        If .Range("G" & Z) = "G" Then .Cells(X, AleTri) = .Cells(Z, "E").Value
                        If .Range("C" & Z) = "P" Then .Cells(X, AleTri + 2) = .Cells(Z, "A").Value
                        If .Range("G" & Z) = "P" Then .Cells(X, AleTri + 2) = .Cells(Z, "E").Value
                        X = X + 1
                        
                Next Z
                
                Call AleatoireTaT
                Call LeTriTat
                
                'AleTri = 34                             ' numéro de la colonne Perdants
                
                Call AleatoireTaT
                Call LeTriTat
                
                Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row
                Pl = .Range("Pl_" & Partie).Value
                
                ''''' Les gagnants ********************
                Y = .Range("Pl_" & Partie).Value '''''''''''' premier bloc
                
                For Z = 1 To Nb_Lignes Step 2
                
                    For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
                        If Cl.Value = .Cells(Z, "AF").Value Then
                                
                            .Range("A" & Y) = .Cells(Cl.Row, Cl.Column)
                            .Range("B" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                            .Range("B" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                            .Range("B" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                            Y = Y + 4
                                        
                        End If
                        
                    Next Cl
                        
                Next Z
                
                Y = .Range("Pl_" & Partie).Value  ''''''''''''' les adversaires
                
                For Z = 2 To Nb_Lignes Step 2
                
                    For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
                        If Cl.Value = .Cells(Z, "AF").Value Then
                        
                            .Range("E" & Y) = .Cells(Cl.Row, Cl.Column)
                            .Range("F" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                            .Range("F" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                            .Range("F" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                            Y = Y + 4
                                
                        End If
                        
                    Next Cl
                Next Z
                
                '''''' Les perdants *****************
                
                Nb_Lignes = .Cells(Rows.Count, "AH").End(xlUp).Row
                
                Y = .Range("Pl_" & Partie).Value  '''''''''''' premier bloc
                
                For Z = 1 To Nb_Lignes Step 2
                
                    For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
                        If Cl.Value = .Cells(Z, "AH").Value Then
                        
                            .Range("i" & Y) = .Cells(Cl.Row, Cl.Column)
                            .Range("J" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                            .Range("J" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                            .Range("J" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                            Y = Y + 4
                            
                        End If
                        
                    Next Cl
                        
                Next Z
                
                Y = .Range("Pl_" & Partie).Value  ''''''''''''' les adversaires
                
                For Z = 2 To Nb_Lignes Step 2
                
                    For Each Cl In .Range("A4:A" & Dl, "E4:E" & Dl)
                        
                        If Cl.Value = .Cells(Z, "AH").Value Then
                        
                            .Range("M" & Y) = .Cells(Cl.Row, Cl.Column)
                            .Range("N" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                            .Range("N" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                            .Range("N" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                            Y = Y + 4
                                
                        End If
                    
                    Next Cl
                        
                Next Z
                
                Call EnteteLesP
                Call GrilleLesP
                
                Dl = .Cells(Rows.Count, "A").End(xlUp).Row
                
                With .Shapes.Range("Button 1") ' postionne le bouton "Tirage des partie" selon la derniere ligne de la Partie
                
                    .Left = Cells(Dl - 2, "Q").Left 'Y
                    .Top = Cells(Dl - 2, "Q").Top 'Z
                    .TextFrame.Characters.Text = "Tirage " & Chr(10) & Partie + 1 & "e partie" & Chr(10) & "Doublette"

                End With
'
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
                
        End With
        
        Application.ScreenUpdating = True
                
End Sub


' ======================================================================
' =                                           TIRAGE 3eme Partie TRIPLETTES                                              =
' ======================================================================

Sub GagnantsConcoursTriplette_3eP()

    Dim Cl As Range
    Dim Xa As Integer, Xc As Integer
    Dim Ya As Integer, Yc As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim Z As Integer
    Dim Nb_Lignes As Integer                        '  derniere ligne tirage aélatoire (colonne AF et AH) ??????????????????????????????????????????????
        
    Application.ScreenUpdating = False

    With Worksheets("Concours")
    'Dl = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        Pl = .Range("Pl_" & Partie - 1)
        Xa = Application.WorksheetFunction.CountA(.Range("A" & Pl & ":A" & Dl))
        Xc = Application.WorksheetFunction.CountA(.Range("C" & Pl & ":C" & Dl))
        Ya = Application.WorksheetFunction.CountA(.Range("i" & Pl & ":i" & Dl))
        Yc = Application.WorksheetFunction.CountA(.Range("K" & Pl & ":K" & Dl))
        
        If Xa <> Xc Then
        
            MsgBox "Il semble que tous les résultats ne soient pas saisis !", vbExclamation, "Il manque les résultats de " & Xa - Xc & " équipes /" & Xa & " !"
            Exit Sub
                    
        End If
        
        If Ya <> Yc Then
        
            MsgBox "Il semble que tous les résultats ne soient pas saisis !", vbExclamation, "Il manque les résultats de " & Ya - Yc & " équipes /" & Ya & " !"
            Exit Sub
            
        End If
        
        .Unprotect
                    
        Dl = .Cells(Rows.Count, "A").End(xlUp).Row
        Pl = .Range("Pl_" & (Partie))
        
        For X = Pl To Dl Step 3
        
                    .Range("C" & X & ":C" & X + 2).Locked = True
                    .Range("G" & X & ":G" & X + 2).Locked = True
                    .Range("K" & X & ":K" & X + 2).Locked = True
                    .Range("O" & X & ":O" & X + 2).Locked = True
            
        Next X
                    
        X = Application.WorksheetFunction.CountA(.Range("C" & .Range("Pl_" & Partie).Value & ":C" & Dl + 1))
        
        If X > 0 Then
        
            MsgBox "Il y a déja des gagnants inscrit en 3e Partie. Impossible de continuer."
            End
            
        End If
    
        ' efface la plage "AF1:AFx" et "AH1:AHx" ou sont tirés au sort les équipes ???????????????????????????????????????????????????????????????
        Dl = .Cells(Rows.Count, "AF").End(xlUp).Row
        .Range("AF1:AF" & Dl).ClearContents
        .Range("AH1:AH" & Dl).ClearContents
                 
        ' Derniere ligne de la colonne A une 2e fois car le champ 2e Partie a été effacé
        Dl = .Cells(Rows.Count, "A").End(xlUp).Row
        Pl = .Range("Dl_" & Partie - 2) + 8
                    
        X = 1
        AleTri = 32  ' numéro de la colonne Gagnants
        
        For Each Cl In .Range("A" & Pl & ":A" & Dl)
        
            If Cl > 0 Then
            
                ' Recherche la lettre "G" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des gagnants "AG"
                If .Cells(Cl.Row, "C") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "A").Value
                If .Cells(Cl.Row, "G") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "E").Value
                X = X + 1
                
            End If
                    
        Next Cl
        
        Call AleatoireTaT
        Call LeTriTat
    
        X = 1
        AleTri = 34  ' numéro de la colonne Perdants
                    
        For Each Cl In .Range("i" & Pl & ":i" & Dl)
                        
            If Cl > 0 Then
            
                    If .Cells(Cl.Row, "K") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "i").Value
                    If .Cells(Cl.Row, "O") = "G" Then .Cells(X, AleTri) = .Cells(Cl.Row, "M").Value
                    X = X + 1
                
            End If
                        
        Next Cl
                    
        Call AleatoireTaT
        Call LeTriTat
                
        Nb_Lignes = .Cells(Rows.Count, "AF").End(xlUp).Row
        Pl = .Range("Pl_" & Partie - 1)
                
                
        ''''' Les gagnants ********************
                    
        Y = .Range("Pl_" & Partie).Value  '''''''''''' premier bloc
                     
        For Z = 1 To Nb_Lignes Step 2
        
            For Each Cl In .Range("A" & Pl & ":A" & Dl, "E" & Pl & ":E" & Dl)
                                
                If Cl.Value = .Cells(Z, "AF").Value Then
                                        
                    .Range("A" & Y) = .Cells(Cl.Row, Cl.Column)
                    .Range("B" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                    .Range("B" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                    .Range("B" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                    Y = Y + 4
                                            
                End If
                                    
            Next Cl
            
        Next Z
                    
                    
        Y = .Range("Pl_" & Partie).Value  ''''''''''''' les adversaires
    
        For Z = 2 To Nb_Lignes Step 2
        
            For Each Cl In .Range("A" & Pl & ":A" & Dl, "E" & Pl & ":E" & Dl)
            
                 If Cl.Value = .Cells(Z, "AF").Value Then
                 
                        .Range("E" & Y) = .Cells(Cl.Row, Cl.Column)
                        .Range("F" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                        .Range("F" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                        .Range("F" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                        Y = Y + 4
                    
                End If
                
            Next Cl
        Next Z
                    
                    
    '''' Les perdants *****************
        Nb_Lignes = .Cells(Rows.Count, "AH").End(xlUp).Row
       
        Y = .Range("Pl_" & Partie).Value   '''''''''''' premier bloc
       
        For Z = 1 To Nb_Lignes Step 2
        
            For Each Cl In .Range("i" & Pl & ":i" & Dl, "M" & Pl & ":M" & Dl)
            
                If Cl.Value = .Cells(Z, "AH").Value Then
                
                    .Range("i" & Y) = .Cells(Cl.Row, Cl.Column)
                    .Range("J" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                    .Range("J" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                    .Range("J" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                    Y = Y + 4
                        
                End If
                
            Next Cl
                    
        Next Z
        
                
        Y = .Range("Pl_" & Partie).Value   ''''''''''''' les adversaires
        
        For Z = 2 To Nb_Lignes Step 2
        
            For Each Cl In .Range("i" & Pl & ":i" & Dl, "M" & Pl & ":M" & Dl)
            
                If Cl.Value = .Cells(Z, "AH").Value Then
                
                    .Range("M" & Y) = .Cells(Cl.Row, Cl.Column)
                    .Range("N" & Y) = .Cells(Cl.Row, Cl.Column + 1)
                    .Range("N" & Y + 1) = .Cells(Cl.Row + 1, Cl.Column + 1)
                    .Range("N" & Y + 2) = .Cells(Cl.Row + 2, Cl.Column + 1)
                    Y = Y + 4
                        
                End If
                
            Next Cl
            
        Next Z
                    
        Call EnteteLesP
        Call GrilleLesP
        
        Dl = .Cells(Rows.Count, "A").End(xlUp).Row
                    
        With .Shapes.Range("Button 1") ' postionne le bouton "Tirage 2e partie" selon la derniere ligne de la Partie1
                    
            .Left = Cells(Dl, "Q").Left 'Y
            .Top = Cells(Dl, "Q").Top 'Z
            .TextFrame.Characters.Text = "Tirage " & Chr(10) & Partie + 1 & "e partie" & Chr(10) & "Triplette"

        End With
 
'      .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
                    
    End With

    Application.ScreenUpdating = True

End Sub