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
| Option Explicit
Sub Essai_PDFMaker()
Dim sNomFichier As String
sNomFichier = Feuil2.Range("A1")
If NomFichierValide(sNomFichier) Then
sNomFichier = Replace(sNomFichier, ",", ".")
Feuil2.Range("A1") = sNomFichier
sNomFichier = ThisWorkbook.Path & "\" & sNomFichier
SavePDF sNomFichier
Else
With Feuil2
.Activate
.Range("A1").Select
End With
MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly
End If
End Sub
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
NomFichierValide = True
If Len(sChaine) = 0 Then
NomFichierValide = False
Exit Function
End If
For i = 1 To Len(CaracInterdits)
If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
NomFichierValide = False
Exit Function
End If
Next i
End Function
Private Sub Nettoyage()
Dim shp As Shape, sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
For Each shp In sh.Shapes
If InStr(shp.Name, "ZoneTexte") Or InStr(shp.Name, "Connecteur") > 0 Then
shp.Delete
End If
Next shp
Next sh
End Sub
Private Sub SavePDF(sNomFichier As String)
Dim i As Long
Dim appPDFMaker As AdobePDFMakerForOffice.PDFMaker
Dim appSettings As AdobePDFMakerForOffice.ISettings
Application.ScreenUpdating = False
For i = 1 To Application.COMAddIns.Count
If InStr(UCase$(Application.COMAddIns(i).Description), "PDFMAKER") > 0 Then
Set appPDFMaker = Application.COMAddIns(i).Object
Exit For
End If
Next i
appPDFMaker.GetCurrentConversionSettings appSettings
With appSettings
.AddBookmarks = True
.AddLinks = True
.AddTags = True
.AdvancedTagging = True
.ConvertAllPages = True
.CreateFootnoteLinks = True
.CreateXrefLinks = True
.FitToOnePage = False
.OutputPDFFileName = sNomFichier
.PromptForSheetSelection = False
.ShouldShowProgressDialog = False
.ViewPDFFile = False
End With
appPDFMaker.CreatePDFEx appSettings, 0
Nettoyage
Application.ScreenUpdating = True
Set appSettings = Nothing
Set appPDFMaker = Nothing
End Sub |
Enregistrer tableau excel en pdf avec AcrobatMaker via VBA
Répondre avec citation
Partager