Impression PDF en VBA - Problème d'affichage pour les images
Bonjour à tous,
A partir de la macro suivante, j'exporte en PDF les signets d'un fichier, ça marche bien.
Seulement, j'ai des images, mais elles ne sont pas intégrées dans le PDF.
Si je fais fichier > enregistrer sous > PDF, j'ai les images.
Via la macro, je ne les ai pas.
Code:
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
|
Sub SaveSignetsPDF() 'Pierre Octobre 2018
Dim FileName$, FolderName$, Folderstring$, FilePathName$, LeParcours$
'Set the Orientation of the sheet, seems to default to xlPortait
'if we not use this code line. This is a bug in Mac Excel 2016
ActiveSheet.PageSetup.Orientation = ActiveSheet.PageSetup.Orientation
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
' Début de la boucle
For I = 1 To WS_Count
'récupere un texte dans une cellule du signet, le texte est utilisé pour le nom du fichier
Stagiaire = Worksheets(I).Range("A59").Value
NO = Worksheets(I).Name
NomFormation = "Nom de la formation - "
FileName = NomFormation & Stagiaire & ".pdf"
'FileName = Format(Date, "yyyymmdd") & " " & Stagiaire & ".pdf"
'Make folder in the Office folder if it not exists and create the path/file name
FolderName = "PDFSaveFolder"
Folderstring = CreateFolderinMacOffice2016(NameFolder:=FolderName)
FilePathName = Folderstring & Application.PathSeparator & FileName
'Réduire les marges à 0,2
Worksheets(I).PageSetup.PrintArea = "$A$1:$C$42"
Application.PrintCommunication = False
With Worksheets(I).PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.Orientation = xlPortrait
End With
Application.PrintCommunication = True
'Faire une sélection avant impression
'Range("A1:I35").Select
'ExportAsFixedFormat is not working correct in Mac Excel 2016, for example:
'expression A variable that represents a Workbook, Sheet, Chart, or Range object
'is not working if you change ActiveWorkbook, it always save the activesheet.
'Also the parameters are not working like in Win Excel.
Worksheets(I).ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FilePathName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False
Next I
MsgBox "Votre fichier PDF à été enregistré sous : " & FilePathName, , "Chemin de votre Fichier PDF"
End Sub
Function CreateFolderinMacOffice2016(NameFolder As String) As String
'Function to create folder if it not exists in the Microsoft Office Folder Ron de Bruin : 8-Jan-2016
Dim OfficeFolder$, PathToFolder$, TestStr$
OfficeFolder = MacScript("return POSIX path of (path to desktop folder) as string")
OfficeFolder = Replace(OfficeFolder, "/Desktop", "") & _
"Library/Group Containers/UBF8T346G9.Office/"
PathToFolder = OfficeFolder & NameFolder
On Error Resume Next
TestStr = Dir(PathToFolder, vbDirectory)
On Error GoTo 0
If TestStr = vbNullString Then
MkDir PathToFolder
End If
CreateFolderinMacOffice2016 = PathToFolder
End Function |
Merci pour votre aide.