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 |
Partager