XL 2016 macro imprimer via inputbox

KTM · 16 Mai 2019

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 · 16 Mai 2019

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 · 16 Mai 2019

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 · 16 Mai 2019

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 · 16 Mai 2019

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

KTM · 16 Mai 2019

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

XL 2016 macro imprimer via inputbox

KTM

XLDnaute Impliqué

Pièces jointes

Hasco

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

KTM

XLDnaute Impliqué

job75

XLDnaute Barbatruc

KTM

XLDnaute Impliqué

Discussions similaires