Sub Print()
Dim P As Byte, t as Integer, u as Integer, Lignes()
P = MsgBox(Range("Database!K33"), vbYesNo + vbDefaultButton1)
If P = vbNo Then Exit Sub
Application.Dialogs(xlDialogPrinterSetup).Show
With Sheets("Action Plan")
Lignes() = Array(8, 49, 105, 113) 'mettre les lignes de départ de chaque tableau + ligne de fin du dernier tableau +5
For t = 0 To UBound(Lignes) - 1
For u = Lignes(t) To Lignes(t + 1) - 5 Step 3
.Shapes.AddShape(msoShapeRectangle, .Range("B1").Left, Range("B" & u).Top, Columns("B:D").Width, .Range("B" & u).Height).Select 'On colle un pavé au bon endroit
Selection.Name = "Gniarf" & t & "_" & u 'on lui donne un nom
Selection.ShapeRange.Line.Visible = msoFalse 'on voit plus les bordures
Next u
Next t
.PageSetup.PrintArea = "$B$1:$Q$610"
With .PageSetup
.PaperSize = xlPaperA4
.Orientation = xlLandscape
.FitToPagesWide = 1
.BlackAndWhite = True
End With
.PrintOut Copies:=1
For t = 0 To UBound(Lignes) - 1 'Boucle d'effacement des pavés créés
For u = Lignes(t) To Lignes(t + 1) - 5 Step 3
.Shapes("Gniarf" & t & "_" & u).Delete
Next u
Next t
End With
End Sub