Bonjour Emmaude, le Forum,
Ce que j'avais réalisé, à, adapter :
Sub ImprimFiche() 'C ok
Dim C As Range
Application.ScreenUpdating = False
Sheets("Fiche").Activate
'MsgBox "Voulez-vous imprimer une fiche vierge,vbYesNo"
' le critical c'est juste pour la croix rouge.
reponse = MsgBox("Cliquez sur OUI pour imprimer une fiche vierge.?" & vbLf & vbLf & "Cliquez sur NON pour imprimer toutes les Fiches.", vbYesNo + vbCritical, "titre")
If reponse = vbYes Then
'J'efface le nom
Sheets("Fiche").Range("D3:I3").ClearContents
'Je souligne les zones de saisie
Range( _
"D6:E6,H6,D8,F8:H8,D12,H12,D14,F14,D16:H16,D18:H18,D20,F20:H20,D22,G22:H22,D26,G26:H26,D28:E28,G28:H28,D30:H30,D32:H32,D34,F34:H34,D36,H36,D38:J38" _
).Select
With Selection.Borders(xlEdgeBottom).LineStyle = xlDot
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'je supprime le soulignement
Range("D6:J39").Select
With Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'Afin de ne pas rester en sélection
Range("D3").Activate
Else
'Je sélectionne le premier Nom de ma liste
[Fiche!D3] = [Eleves!C4]
'J'inscris le pied de page
ActiveSheet.PageSetup.LeftFooter = "Impression effectuée en date du " & Format(Range("C41").Value, "d mmmm yyyy")
'J'imprime toutes les fiches
For Each C In Range("Eleves")
If WorksheetFunction.CountA(Range("D3").MergeArea) = 0 Then Exit Sub
Range("Noms").Value = C.Value
Sheets("Graph").PrintOut
Next C
End If
Sheets("Accueil").Activate
Application.ScreenUpdating = True
End Sub
En espérant que ceci te sera utile.