1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
| Private Sub Commande110_Click()
Dim rs As DAO.Recordset
Dim sFolder As String
Dim sFile As String
'changer le code de l'etat***************************************************************************************************************************
Const sReportName = "9 FICHES1"
'On Error GoTo Error_Handler
'The folder in which to save the PDFs
sFolder = Application.CurrentProject.Path & "\"
'Définissez les enregistrements que vous utiliserez pour filtrer le rapport avec************************************************************************************
Set rs = CurrentDb.OpenRecordset("SELECT CFRP, Relation FROM 9FICHES;", dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then 'Make sure we have record to generate PDF with
.MoveFirst
Do While Not .EOF
'Construisez le nom de fichier PDF que nous allons utiliser pour enregistrer le PDF avec*************************************************************************
sFile = sFolder & Nz(![Relation], "") & ".pdf"
'Ouvrez le rapport filtré sur l'enregistrement ou les critères spécifiques souhaités en mode caché******************************************************
DoCmd.OpenReport sReportName, acViewPreview, , "[CFRP]='" & ![CFRP] & "'", acHidden
'Imprimez-le au format PDF
DoCmd.OutputTo acOutputReport, sReportName, acFormatPDF, sFile, , , , acExportQualityPrint
'Fermez le rapport maintenant que nous en avons fini avec ces critères
DoCmd.Close acReport, sReportName
'Si vous souhaitez créer un e-mail et inclure un rapport individuel, vous le ferez maintenant
.MoveNext
Loop
End If
End With
'Open the folder housing the PDF files (Optional)
Application.FollowHyperlink sFolder
Error_Handler_Exit:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Exit Sub
Error_Handler:
If Err.Number <> 2501 Then 'Let's ignore user cancellation of this action!
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Command0_Click" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
End If
End Sub |
Partager