Sub Mise_en_page()
'
' Mise_en_page

Dim DerLig As Long, r As Long
Dim MaPlage As Range, MaRech As Range
 
DerLig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
Set MaPlage = Sheets(ActiveSheet.Name).Range(Cells(2, 1), Cells(DerLig, 1))
'Insere AI, AN, AO, AP, AZ, AQ, AR, AJ si lignes manquants
With MaPlage
    Set MaRech = .Find("AI", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AI"
        End If
End With
 
With MaPlage
    Set MaRech = .Find("AN", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AN"
        End If
End With
 
With MaPlage
    Set MaRech = .Find("AO", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AO"
        End If
End With
 
With MaPlage
    Set MaRech = .Find("AP", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AP"
        End If
End With
 
With MaPlage
    Set MaRech = .Find("AZ", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AZ"
        End If

End With
 
With MaPlage
    Set MaRech = .Find("AQ", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AQ"
        End If

End With
 
With MaPlage
    Set MaRech = .Find("AR", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AR"
        End If

End With

With MaPlage
    Set MaRech = .Find("AJ", LookIn:=xlValues)
        If MaRech Is Nothing Then
            DerLig = DerLig + 1
            Cells(DerLig, 1) = "AJ"
        End If

End With

'Classement des A/C

    Cells.Select
    Application.DeleteCustomList ListNum:=5
    Application.AddCustomList ListArray:=Array("AI", "AN", "AO", "AP", "AZ", "AQ", "AR" _
        , "AJ")
     
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _
        "A2:A39"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "AI,AN,AO,AP,AZ,AQ,AR,AJ", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("A2:CV39")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _
        "A2:A39"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "AI,AN,AO,AP,AZ,AQ,AR,AJ", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _
        "C2:C39"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("A2:CV39")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        
    End With
    
      

'Insertion de lignes entre chaque A/C

DerLig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 'recalcule la dernière
For r = 3 To DerLig + 15 '+15 pour avoir une marge pour les lignes insérées à adapter selon le nombre d'ID
    If Cells(r, 1) <> "" Then 'Evite les lignes vides crées
        If Cells(r, 1) = Cells(r - 1, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
      r = r + 1
             If Cells(r, 1) = Cells(r - 2, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 3, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 4, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 5, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 6, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 7, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 8, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 9, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)
       r = r + 1
             If Cells(r, 1) = Cells(r - 10, 1) Then 'vérifie si = à la ligne précédente
            Cells(r, 1).Clear 'efface la valeur car égale à ligne précédente (problème3)

           End If
        End If
        End If
        End If
        End If
        End If
        End If
        End If
        End If
        End If
        
    End If
   
            Rows(r).Insert Shift:=xlDown 'Insert une ligne après la ligne en question (problème2)
            r = r + 1 'incrémente pour passer la ligne insérée
  
Next r


' Taille_colonnes Macro
'
    Columns("B:B").Select
    Selection.ClearContents
    Columns("G:G").Select
    Selection.Cut Destination:=Columns("B:B")
    Columns("A:A").Select
    Selection.ColumnWidth = 5
    Columns("B:B").Select
    Selection.ColumnWidth = 8
    Columns("C:F").Select
    Selection.ColumnWidth = 5
    Columns("G:G").Select
    Selection.ColumnWidth = 2
    Range("H:H,J:J,L:L,N:S").Select
    Range("N1").Activate
    Selection.ColumnWidth = 3
    Range("I:I,K:K").Select
    Range("K1").Activate
    Selection.ColumnWidth = 1
    Columns("M:M").Select
    Selection.ColumnWidth = 2
    Columns("Q:Q").Select
    Selection.ColumnWidth = 20
    Columns("A:Q").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "TR"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "DY"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "WY"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "RQ"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "CF"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "NR"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "MRO / Comments"
    
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "PO"
    Range("P2").Select

' Case_a_cocher Macro
'

nh = 2

Do Until nh = 100

If Cells(nh, 2) <> "" Then

    Cells(nh, 8).Select
    ActiveCell.FormulaR1C1 = "O"
    Cells(nh, 10).Select
    ActiveCell.FormulaR1C1 = "O"
    Cells(nh, 12).Select
    ActiveCell.FormulaR1C1 = "O"
    Cells(nh, 14).Select
    ActiveCell.FormulaR1C1 = "O"
    Cells(nh, 15).Select
    ActiveCell.FormulaR1C1 = "O"
    Cells(nh, 16).Select
    ActiveCell.FormulaR1C1 = "O"
    Cells(nh, 17).Select
    ActiveCell.FormulaR1C1 = "O"
      
    
    ' Ajout pointillet à la fin de la ligne
    Cells(nh, 18).Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDot
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
      
    End If
        
   nh = nh + 1
   Loop

'insere ligne en haut pour creation

 Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("N1:R1").Select
    Range("R1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    
    ActiveCell.FormulaR1C1 = "Special assistance request"
    Range("N2").Select
    
    'Selection le tableau à encadrer
    
    
Range("N1:R" & [B100].End(xlUp).Row).Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
   
'colore la zone grisée du tableau
   
   Range("N2:Q" & [B100].End(xlUp).Row).Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
   
   
   'Encadre la case special assistane request
    
    Range("N1:R1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


'Met en gras le texte des colonnes

    Range("N1:R1,H2:R2").Select
    Range("R2").Activate
    Selection.Font.Bold = True
    Columns("A:A").Select
    Selection.Font.Bold = True
    

    Columns("U:DD").Select
    Selection.Delete Shift:=xlToLeft
    Range("U6").Select

' MEP_impression Macro
'
Range("A1:R" & [B100].End(xlUp).Row).Select


    ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
        "C:\Documents and Settings\Administrateur\Mes documents\Mes images\Logo 2.jpg"
    With ActiveSheet.PageSetup.LeftHeaderPicture
        .Height = 56.25
        .Width = 99.75
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = "&G"
        .CenterHeader = _
        "&""-,Gras""&20BIE FLIGHT SHEDULE&""-,Normal""&11" & Chr(10) & "&""-,Gras""&16DATE: &A"
        .RightHeader = ""
        .LeftFooter = "Created by Air Mediterranée"
        .CenterFooter = ""
        .RightFooter = "Printed on &D"
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
'

' Marges Macro
'
    With ActiveSheet.PageSetup

        .TopMargin = Application.InchesToPoints(1.11)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.17)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    With ActiveSheet.PageSetup
        .RightMargin = Application.InchesToPoints(0.18)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    With ActiveSheet.PageSetup
        .BottomMargin = Application.InchesToPoints(0.59)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = "&G"
        .CenterHeader = _
        "&""-,Gras""&20BIE FLIGHT SHEDULE&""-,Normal""&11" & Chr(10) & "&""-,Gras""&16DATE: &A"
        .RightHeader = ""
        .LeftFooter = "Created by Air Mediterranée"
        .CenterFooter = ""
        .RightFooter = "Printed on &D"
        .LeftMargin = Application.InchesToPoints(0.15748031496063)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(1.10236220472441)
        .BottomMargin = Application.InchesToPoints(0.590551181102362)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With



End Sub