Option Explicit

' ======================================================================
'                   TIRAGE 1ere partie DOUBLETTES
' ======================================================================

Sub Doublettes()

        Dim i As Integer
        'Dim Y As Integer
        Dim Z As Integer
        
        
        Application.ScreenUpdating = False
        
        Tirage 2
         
        With Worksheets("Concours")
        
            .Unprotect
            
            'Dl = .Cells(Rows.Count, "A").End(xlUp).Row
            'Z = 0
            
            Call M_7EnteteEtGrilles.Entete
            
            For i = 2 To Sheets("Inscriptions").Cells(Rows.Count, 14).End(xlUp).Row Step 2 ' Lit la liste colonne "N"
                    
                    .Range("A" & (i * 2) + Z) = Sheets("Inscriptions").Range("N" & i)                               ' "Tirage Equipes vers "Inscription"   ??????????????????????
                    .Range("B" & (i * 2) + Z) = Sheets("Inscriptions").Range("O" & i)
                    .Range("B" & (i * 2) + 1 + Z) = Sheets("Inscriptions").Range("P" & i)
                    .Range("E" & (i * 2) + Z) = Sheets("Inscriptions").Range("N" & i + 1)
                    .Range("F" & (i * 2) + Z) = Sheets("Inscriptions").Range("O" & i + 1)
                    .Range("F" & (i * 2) + 1 + Z) = Sheets("Inscriptions").Range("P" & i + 1)
                    
                    Z = Z - 1
            
            Next i
            
            .Range("Dl_1") = .Cells(Rows.Count, "A").End(xlUp).Row 'ajout Dan pour avoir une valeur en AJ11
            
            Call M_7EnteteEtGrilles.Grille1Doublette
            
            Dl = .Cells(Rows.Count, "A").End(xlUp).Row
            
            With .Shapes.Range("Button 1")                           ' postionne le bouton "Tirage Xieme partie" selon la derniere ligne de la Partie1
            
                .Left = Cells(Dl, "i").Left
                .Top = Cells(Dl, "i").Top
                .TextFrame.Characters.Text = "Tirage " & Chr(10) & "2e partie" & Chr(10) & "Doublette"
                
            End With

'           .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            .Range("J1") = "En cours"
        End With
        
Application.ScreenUpdating = True

End Sub

' ======================================================================
' =                                       TIRAGE 2eme PARTIE DOUBLETTES                                          =
' ======================================================================

Sub GagnantsConcoursDoublette_2eP() 'Tirage 2iemme partie du concours

        Dim Cl As Range
        Dim Xa As Integer, Xc As Integer
        Dim X As Integer, Y As Integer, Z As Integer
        Dim DerLig As Integer

        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  'déprotege le feuille

            For X = 4 To Dl Step 3

                .Range("C" & X & ":C" & X + 1).Locked = True
                .Range("G" & X & ":G" & X + 1).Locked = True

            Next X

            If .Cells(Dl, "F") = "" Then .Range("E" & Dl & ":E" & Dl + 1).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 pour la 1 ere partie
            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 "AF" Gagnants
                
            For Z = 4 To Dl Step 3

                ' 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
                X = X + 1

            Next Z

            Call AleatoireTaT
            Call LeTriTat

            X = 1
            AleTri = 34     ' numéro de la colonne "AH" Perdants

            For Each Cl In .Range("C4:C" & Dl)

                If Cl > 0 Then

                     ' Recherche la lettre "P" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des perdants "AF"
                    If .Cells(Cl.Row, "C") = "P" Then .Cells(X, AleTri) = .Cells(Cl.Row, "A").Value
                    If .Cells(Cl.Row, "G") = "P" Then .Cells(X, AleTri) = .Cells(Cl.Row, "E").Value
                    X = X + 1

                End If

            Next Cl

            Call AleatoireTaT
            Call LeTriTat

            DerLig = .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 DerLig 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)
                            Y = Y + 3

                    End If

                Next Cl

            Next Z

            Y = .Range("Pl_" & Partie).Value  ''''''''''''' les adversaires

            For Z = 2 To DerLig 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)
                        Y = Y + 3

                    End If

                Next Cl

            Next Z

            '        ''''' Les perdants *****************
            DerLig = .Cells(Rows.Count, "AH").End(xlUp).Row

            Y = .Range("Pl_" & Partie).Value  '''''''''''' premier bloc

            For Z = 1 To DerLig 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)
                        Y = Y + 3

                    End If

                Next Cl

            Next Z

            Y = .Range("Pl_" & Partie).Value  ''''''''''''' les adversaires

            For Z = 2 To DerLig 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)
                        Y = Y + 3

                    End If

                Next Cl

            Next Z

            Call EnteteLesP
            Call GrilleLesP

            Dl = Cells(Rows.Count, "A").End(xlUp).Row

            With .Shapes("Button 1")

                .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 DOUBLETTES                                          =
' ======================================================================

Sub GagnantsConcoursDoublette_3eP() ' Tirage 3ieme partie concours

        Dim Cl As Range
        Dim Xa As Integer, Xc As Integer
        Dim Ya As Integer, Yc As Integer
        Dim X As Integer, Y As Integer, 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
            
            .Range("Dl_" & Partie) = .Cells(Rows.Count, "A").End(xlUp).Row
            
            Pl = .Range("Dl_" & (Partie - 2)) + 8
            
            For X = Pl To Dl Step 3
            
                .Range("C" & X & ":C" & X + 1).Locked = True
                .Range("G" & X & ":G" & X + 1).Locked = True
                .Range("K" & X & ":K" & X + 1).Locked = True
                .Range("O" & X & ":O" & X + 1).Locked = True
            
            Next X
                
            X = Application.WorksheetFunction.CountA(.Range("C" & .Range("Dl_" & Partie).Value + 8 & ":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 pour la 1 ere partie
            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
            
            For Each Cl In .Range("A" & Pl & ":A" & Dl)
                    ' 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 Cl > 0 Then
                
                    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
                    
                    ' Recherche la lettre "P" dans les colonnes C et G et transfére le N° d'équipe colonnes "A" et "E" en colonne des perdants "AF"
                    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("Dl_" & Partie - 2) + 8
            
            ''''' Les gagnants *******************
            Y = .Range("Dl_" & Partie).Value + 8 '''''''''''' 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)
                        Y = Y + 3
                    
                    End If
                
                Next Cl
                    
            Next Z
            
            Y = .Range("Dl_" & Partie).Value + 8 ''''''''''''' 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)
                        Y = Y + 3
                    
                    End If
                
                Next Cl
                    
            Next Z
            
            '''''' Les perdants *****************
            Nb_Lignes = .Cells(Rows.Count, "AH").End(xlUp).Row
            
            Y = .Range("Dl_" & Partie).Value + 8  '''''''''''' 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)
                        Y = Y + 3
                            
                    End If
                
                Next Cl
                    
            Next Z
            
            Y = .Range("Dl_" & Partie).Value + 8  ''''''''''''' 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)
                        Y = Y + 3
                        
                    End If
                
                Next Cl
                    
            Next Z
            
            Call EnteteLesP
            Call GrilleLesP
            
            Dl = .Cells(Rows.Count, "A").End(xlUp).Row
            Y = .Cells(Dl, "Q").Left
            Z = .Cells(Dl, "Q").Top
            
            With .Shapes.Range("Button 1") ' postionne le bouton "Tirage 2e partie" selon la derniere ligne de la Partie1
            
                .Left = Y
                .Top = Z
                .TextFrame.Characters.Text = "Tirage " & Chr(10) & Partie + 1 & "e partie" & Chr(10) & "Tete a tete"
                
            End With

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