RESOLU - Feuille de visite - Merci phlaurent55

LignesOùRelat(Rows(3), "E", "<>", "X").EntireRow.Hidden = True

LignesOùCondR1C1(Rows(3), "UCASE(RC5)<>""X""").EntireRow.Hidden = True

Function ColLignesOùRelat(ByVal CelDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Rem. ——— Cellules partant de CelDéb dans sa colonne où la colonne ColQuoi est en relation Opé avec Valeur.
Set ColLignesOùRelat = Intersect(LignesOùRelat(CelDéb, ColQuoi, Opé, Valeur), CelDéb.EntireColumn)
End Function

Function LignesOùRelat(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Rem. ——— Lignes entières partant de LigneDéb où la colonne ColQuoi est en relation Opé avec une Valeur.
If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
   """", """""") & """" Else Valeur = Trim$(Str$(Valeur))
Set LignesOùRelat = LignesOùCondR1C1(LigneDéb, CondR1C1:="RC" & ColQuoi & Opé & Valeur)
End Function

Function ColLignesOùCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Cellules partant de CélDéb dans sa colonne dont les lignes vérifient une condition R1C1 CondR1C1.
Set ColLignesOùCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
End Function

Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb qui vérifient une condition R1C1 CondR1C1.
Dim Lignes As Range, ColTrv As Range
With LigneDéb.Worksheet.UsedRange
   Set Lignes = LigneDéb.EntireRow.Resize(.Rows.Count + .Row - LigneDéb.Row)
   Set ColTrv = Intersect(.Columns(.Columns.Count + 1), Lignes): End With
ColTrv.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
On Error Resume Next
Set LignesOùCondR1C1 = ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow
ColTrv.Delete xlShiftToLeft
End Function

Sub Impression
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("G2").Select

    For I = 2 To Range("A300").End(xlUp).Row
            If UCase(Cells(I, 5)) <> "X" Then
                 Rows(I).Hidden = True
            Else
                 I = I + 1
             End If
    Next I
 
    ActiveWindow.SelectedSheets.PrintOut Copies:=InputBox("Saisissez le Nombre de copie", "Nombre de copie"), Collate:=True
'    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    ActiveWindow.SelectedSheets.PrintPreview
    c = InputBox("Combien de copies voulez-vous imprimer ?")
    Columns("A:E").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=5
    Selection.AutoFilter
    Range("E2:E300").ClearContents
    Range("A2").Select
CreateObject("Wscript.shell").Popup "Impression envoyée à l'imprimante." & Chr(10) & Chr(10) & "Veuillez patienter Svp." & Chr(10) & Chr(10), 1, "APE Marguerittes", vbExclamation
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub Impression()
Dim derlig As Long, i As Long, NbCopies As Long
    Application.ScreenUpdating = False

    Sheets("Impressions").Activate

    With ActiveSheet
              derlig = .Cells(Rows.Count, "E").End(xlUp).Row
              NbCopies = .Range("g2")  'Ici tu inscrit le nombre de copies à éffectuer
        For i = derlig To 2 Step -1
            If .Cells(i, 5) <> "X" Then
                .Rows(i).Hidden = True
            Else
                .Rows(i).Hidden = False
            End If
        Next i
            .PageSetup.PrintArea = "$A$1:$E$300"
           '.PrintOut Copies:=NbCopies
           .PrintPreview
        For i = derlig To 2 Step -1
            If .Rows(i).Hidden = True Then .Rows(i).Hidden = False
        Next i
    End With
    CreateObject("Wscript.shell").Popup "Impression envoyée à l'imprimante." & Chr(10) & Chr(10) & "Veuillez patienter Svp." & Chr(10) & Chr(10), 1, "Association", vbExclamation
End Sub