XL 2016 macro imprimer via inputbox

[KTM]

Bonjours ma Famille du forum
J'ai une base de données que je voudrais imprimer en fonction du choix du trimestre
J'ai concocté la macro ci dessous mais j'ai l'impression qu'elle est mal agencée et ne fonctionne pas.
Pouvez vous m'apporter un appuis?

Sub Imprimer_Grille()
Dim dl As Integer
Dim T1, T2, T3, T4, T As String
dl = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
If dl = 1 Then MsgBox " Aucun Patient Enregistré ", 48: Exit Sub
If MsgBox(" Voulez_Vous Imprimer la Grille ? ", vbYesNo + 32) = vbYes Then
Dim X As String
X = InputBox("Saisir le Trimestre Souhaité: T1,T2,T3,T4 ", "Impression")
If X = "" Then MsgBox "Aucun Trimestre determiné Veuillez reesayer ", 64: Exit Sub
If X = T1 Or X = T2 Or X = T3 Or X = T3 Or X = T4 Then
ActiveSheet.Range("$G$1:$H$" & dl).AutoFilter Field:=2, Criteria1:="X"
If Application.Dialogs(Excel.XlBuiltInDialog.xlDialogPrinterSetup).Show = False Then Selection.AutoFilter: Exit Sub
With ActiveSheet.PageSetup
.PrintArea = "A1:H" & dl
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = False
.LeftHeader = ""
.CenterHeader = "Grille de Dispensation " & X
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""

End With
Range("A1:H" & dl).PrintOut Copies:=1, Collate:=True
Selection.AutoFilter
End If
End If
Application.ScreenUpdating = True
End Sub

 

[Hasco]

Bonjour,

Vous dites: " j'ai l'impression qu'elle est mal agencée et ne fonctionne pas. "

Pour une macro d'impression mieux vaut être sûr. Soit elle fonctionne soit elle ne fonctionne pas.

Modifier le test:

If InStr(1, "T1;T2;T3;T4", UCase(X)) > 0 Then

et ça ira mieux.

bon après-midi

 

[job75]

Bonjour KTM, Roblochon,

Ce code doit suffire :

Sub Imprimer()
Dim x As String, P As Range
x = InputBox("Saisir le Trimestre Souhaité: T1,T2,T3,T4", "Impression")
If x = "" Then Exit Sub
Application.ScreenUpdating = False
Set P = [A1].CurrentRegion
With ActiveSheet.PageSetup
    .PrintArea = P.Address
    .Zoom = False
    .FitToPagesWide = 1
End With
P.AutoFilter 8, x
ActiveSheet.PrintPreview 'pour tester
'ActiveSheet.PrintOut 'pour imprimer
P.AutoFilter
End Sub

A+

 

[KTM]

Merci à Roblochon et au tout Puissant job75
Une sauce de vos deux solutions donne ceci et c'est du bon:


Dim T1, T2, T3, T4, X As String, p, p1 As Range, dl As Integer
dl = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
If dl = 1 Then MsgBox " Aucun Patient Enregistr? ", 48: Exit Sub
If MsgBox(" Voulez_Vous Imprimer la Grille ? ", vbYesNo + 32) = vbYes Then
X = InputBox("Saisir le Trimestre Souhait?: T1,T2,T3,T4 ", "Impression")
If X = "" Then MsgBox "Aucun Trimestre determin? Veuillez reesayer ", 64: Exit Sub
If InStr(1, "T1;T2;T3;T4", UCase(X)) > 0 Then
If Application.Dialogs(Excel.XlBuiltInDialog.xlDialogPrinterSetup).Show = False Then Exit Sub
ActiveSheet.Unprotect "2580"
Set p = [A1].CurrentRegion.Resize(dl, 8)
Set p1 = [A1].CurrentRegion.Resize(dl, 7)
With ActiveSheet.PageSetup
.PrintArea = p.Address
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = False
.CenterHeader = "Grille de Dispensation ARV " & X
End With
p.AutoFilter 8, X
p1.PrintOut Copies:=1, Collate:=True
p.AutoFilter
ActiveSheet.Protect "2580"
End If
End If
Application.ScreenUpdating = True

 

[job75]

Plus c'est long plus c'est bon, hein KTM

 

[KTM]

SI Vous pouvez m'aider à me débarrasser des lignes inutiles cela ne fera que me faire du bien
Merci Job75