Bonjour à tou(te)s,
Meme si mon préfixe est "XL-2007", je travailles en ce moment sur un fichier qui doit pouvoir être exploité par un pC avec "XL-2003", d'où mon problème, enregistrer en pdf avec PDFCréator (en un seul mot), j'ai beau vérifier et revérifier, je n'arrive pas à enregistrer ma feuille avec ce logiciel.
Pour le cas du PC où mon fichier sera installé, c'est un PC sans droit d'administrateur et seul PdfCréator est installé, ci-dessous, mes codes :
sachant que toutes les variables sont correctement déclarées et vérifiées :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Public Sub SaveAsPDF(Optional ByVal strPDFName As String = "", _ Optional ByVal strDirectory As String = "") Dim pdfc As PDFCreator.clsPDFCreator Dim DefaultPrinter As String Dim c As Long Dim OutputFilename As String prodErreur = False strPDFName = nomfichier ' Instancier un nouvel objet PDFCreator Set pdfc = New clsPDFCreator ' Paramétrer l'objet PDFCreator With pdfc .cStart "/NoProcessingAtStartup" .cOption("UseAutosave") = 1 .cOption("UseAutosaveDirectory") = 1 ' Chemin de destination ' Par défaut : dossier 'Mes documents' de l'utilisateur strDirectory = repert Debug.Print strPDFName If strDirectory = "" Then strDirectory = Environ("USERPROFILE") & "\Mes documents\" End If .cOption("AutosaveDirectory") = strDirectory ' Nom du fichier PDF à générer .cOption("AutosaveFilename") = _ IIf(strPDFName = "", ActiveWorkbook.Name, strPDFName) Call a_supprimer ' Format de sauvegarde (0 = PDF) .cOption("AutosaveFormat") = 0 ' Mémoriser l'imprimante par défaut ' et définir PDFCreator à la place DefaultPrinter = .cDefaultPrinter .cDefaultPrinter = "PDFCreator" .cClearCache 'Imprimer les feuilles sélectionnées ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator" Do Until .cCountOfPrintjobs = 1 ' Attend la Fin du travail pour quitter DoEvents Sleep 1000 Loop Sleep 1000 .cPrinterStop = False End With ' Temporisation c = 0 Do While (pdfc.cOutputFilename = "") And (c < 50) c = c + 1 Sleep 200 Loop ' Nom du fichier PDF produit OutputFilename = pdfc.cOutputFilename ' Réinstaller l'imprimante d'origine With pdfc .cDefaultPrinter = DefaultPrinter Sleep 200 .cClose End With ' Attendre jusqu'à ce que PDFCreator soit supprimé de la mémoire Sleep 2000 ' Vérifier si le fichier a été créé If OutputFilename = "" Then MsgBox "Création du fichier PDF." & vbCrLf & vbCrLf & _ "Une erreur s'est produite : temps écoulé !", vbExclamation + vbSystemModal prodErreur = True End If End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12 Sub a_supprimer() Dim fso As Object, remplacement As String, s As String s = repert & "\" & nomfichier & ".PDF" If ExisteFichier(s) Then remplacement = MsgBox("Le fichier existe déjà" & Chr(10) & "Voulez-vous le remplacer ?", vbOKCancel) If remplacement = 2 Then prodErreur = True: Exit Sub Else Kill (s) End If End If End SubJe ne penses pas qu'il faille s'attarder sur les 2 derniers codes, subsidiaires pour l'instant.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Public Function ExisteFichier(s As String) As Boolean Dim f As Object Set f = CreateObject("Scripting.FileSystemObject") ExisteFichier = f.FileExists(s) End Function
Merci d'avance de vos remarques
Bonne soirée
Partager