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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
| Option Compare Database
Option Explicit
'########################'
' '
' CODE '
' '
'########################'
Public Sub proPDF(ByRef etaPDF As String, Optional ByRef strNomFichier As String)
On Error GoTo Erreur_proPDF
'Déclaration des variables...
'Chemin, fichier et boite de dialogue...
Dim strCheminFichier As String
Dim nbCar As Integer
Dim oFD As FileDialog
Set oFD = Application.FileDialog(msoFileDialogSaveAs)
'Nom de l'imprimante par défaut...
Dim strImprimanteDefautNom As String
strImprimanteDefautNom = Application.Printer.DeviceName
'Nom de l'imprimante PDF...
Dim strImprimantePDFNom As String
strImprimantePDFNom = "PDFCreator"
'Sélection de PDFCreator comme imprimante par défaut...
Set Printer = Printers(strImprimantePDFNom)
'Classe PDFCreator...
Dim oPDF As PDFCreator.clsPDFCreator
Set oPDF = New clsPDFCreator
'Parametres de PDFCreator...
Dim Parametres(0 To 4) As Variant
'Ouverture du fichier PDF...
Dim Reponse As Integer
'Timer...
Dim Temps As Long
'Traitement du nom de fichier...
If IsNull(strNomFichier) Or strNomFichier = "" Then
strNomFichier = ""
ElseIf Right$(strNomFichier, 4) <> ".pdf" Then
strNomFichier = strNomFichier & ".pdf"
End If
'Boite de dialogue...
With oFD
.Title = "Création d'un fichier PDF"
.ButtonName = "Créer PDF"
.AllowMultiSelect = False
.InitialFileName = Application.CurrentProject.Path & "\" & strNomFichier
If .Show = -1 Then
If IsNull(.SelectedItems(1)) Or .SelectedItems(1) = "" Then
MsgBox "Aucun nom de fichier n'a été indiqué ! & vbcrlf & vbcrlf" _
& "Merci de recommencer la procédure...", vbExclamation, "Création PDF..."
GoTo Sortie_proPDF
Else
strNomFichier = StrReverse(Split(StrReverse(.SelectedItems(1)), "\", , vbBinaryCompare)(0))
strCheminFichier = .SelectedItems(1)
If Right$(strNomFichier, 4) <> ".pdf" Then
strNomFichier = strNomFichier & ".pdf"
strCheminFichier = strCheminFichier & ".pdf"
End If
nbCar = Len(strCheminFichier) - Len(strNomFichier)
strCheminFichier = Mid(strCheminFichier, 1, nbCar)
End If
Else
MsgBox "Aucun fichier n'a été enregistré...", vbInformation, "Création PDF..."
GoTo Sortie_proPDF
End If
End With
'Création du PDF...
With oPDF
.cVisible = False
.cStart
'"Sauvegarde" des paramètres de PDFCreator...
Parametres(0) = .cOption("UseAutoSave")
Parametres(1) = .cOption("UseAutoSaveDirectory")
Parametres(2) = .cOption("AutoSaveDirectory")
Parametres(3) = .cOption("AutoSaveFilename")
Parametres(4) = .cOption("autoSaveFormat")
.cSaveOptions
'Changement des paramètres de PDFCreator...
.cOption("UseAutoSave") = 1
.cOption("UseAutoSaveDirectory") = 1
.cOption("AutoSaveDirectory") = strCheminFichier
.cOption("AutoSaveFilename") = strNomFichier
.cOption("autoSaveFormat") = 0 '(0 = PDF)
.cSaveOptions
'Impresion de l'état...
DoCmd.Hourglass True
DoCmd.Echo False
DoCmd.OpenReport etaPDF, acViewNormal, , , acWindowNormal
Do Until .cIsConverted = True
DoEvents
Loop
DoCmd.Echo True
DoCmd.Hourglass False
.cClearCache
.cClearLogfile
'"Restauration" des paramètres de PDFCreator...
.cOption("UseAutoSave") = Parametres(0)
.cOption("UseAutoSaveDirectory") = Parametres(1)
.cOption("AutoSaveDirectory") = Parametres(2)
.cOption("AutoSaveFilename") = Parametres(3)
.cOption("autoSaveFormat") = Parametres(4)
.cSaveOptions
End With
'Ouverture du fichier PDF...
Reponse = MsgBox("Voulez-vous ouvrir le document """ & strNomFichier & """ créé ?", vbQuestion + vbYesNo, _
"Création PDF...")
DoCmd.Hourglass True
DoCmd.Echo False
Temps = Timer + 0.7
Do While Timer < Temps
DoEvents
Loop
DoCmd.Echo True
DoCmd.Hourglass False
oPDF.cClose
Select Case Reponse
Case vbYes
ShellExecute Application.hWndAccessApp, "open", strNomFichier, "", strCheminFichier, 3
End Select
Sortie_proPDF:
Set Printer = Printers(strImprimanteDefautNom)
Set oFD = Nothing
Set oPDF = Nothing
Exit Sub
Erreur_proPDF:
MsgBox Err.Number & " : " & Err.Description
Err.Clear
Resume Sortie_proPDF
End Sub
'###############################'
' '
' UTILISATION '
' '
'###############################'
'Ecrire 'proPDF "nom de l'état à imprimer", "nom du fichier enregistré avec ou sans l'extension .pdf (facultatif)"'
'dans une procédure VBA... |
Partager