XL 2016 macro imprimer via inputbox

KTM

XLDnaute Occasionnel
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
 

Fichiers joints

Roblochon

XLDnaute Impliqué
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:
VB:
If InStr(1, "T1;T2;T3;T4", UCase(X)) > 0 Then
et ça ira mieux.

bon après-midi
 

job75

XLDnaute Barbatruc
Bonjour KTM, Roblochon,

Ce code doit suffire :
VB:
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

XLDnaute Occasionnel
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
 

KTM

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

Discussions similaires


Haut Bas