XL pour MAC enregistrement d'un onglet en pdf avec sous dossier

[tdenis]

Bonsoir le forum,
j'ai crée un code pour enregistrer une feuille en pdf en créant le sous-dossier s'il n'existe pas ..
le soucis est que j'ai un message d'erreur lors de l'impression et le feuille n'est pas créee en pdf mais le dossier quand a lui est bien crée.
pouvez vous m'aider a solutionner ce petit souci.
en vous remerciant par avance
Voici le code:

Sub Enregistrer_Devis_pdf()
Dim MonDossier As String
Dim Monfichier As String
Dim SousDossier As String
Dim DossierCree As String
MonDossier = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/"
Monfichier = Range("L1").Value
SousDossier = Range("F4").Value
DossierCree = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier & "/"
On Error Resume Next
ChDir MonDossier & SousDossier
If Err <> 0 Then
   MkDir MonDossier & SousDossier
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
   DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
   
    MsgBox ("Le dossier " & SousDossier & "  et  Le fichier " & Monfichier & " ont bien été crée et enregistré ")
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
     DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    MsgBox ("Le fichier " & Monfichier & " est bien enregistré ")
     
    With ActiveSheet.Tab
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0
    End With
   
   End If
   

End Sub

 

[kiki29]

Salut, pour ce qui concerne le Mac voir le site de Ron de Bruin : Working with files and Folders, et pour le PDF

 

[kiki29]

Re, autrement dit via la procédure et la fonction suivantes :

SaveActiveSheetAsPDFInMacExcel
CreateFolderInMacOffice

Sub SaveActiveSheetAsPDFInMacExcel()
'Ron de Bruin : 11-Dec-2020
'Test macro to save the ActiveSheet as pdf with ExportAsFixedFormat
'Note : if set it save the printarea
Dim FileName As String
Dim FolderName As String
Dim Folderstring As String
Dim FilePathName As String

    'If my ActiveSheet is landscape, I must attach this line
    'for making the PDF also landscape, seems to default to xlPortait
    ActiveSheet.PageSetup.Orientation = ActiveSheet.PageSetup.Orientation

    'Name of the folder in the Office folder
    FolderName = "PDFSaveFolder"
    'Name of the pdf file
    FileName = ActiveSheet.Name & " " & Format(Now, "dd-mmm-yyyy hh-mm-ss") & ".pdf"

    Folderstring = CreateFolderinMacOffice(NameFolder:=FolderName)
    FilePathName = Folderstring & Application.PathSeparator & FileName

    'expression A variable that represents a Workbook, Sheet, Chart, or Range object.
    'the parameters are not working like in Excel for Windows
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    FileName:=FilePathName, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False

    MsgBox "You find the PDF file in this location : " & FilePathName
End Sub

Function CreateFolderInMacOffice(NameFolder As String) As String
'Function to create folder if it not exists in the Microsoft Office Folder
'Ron de Bruin : 13-July-2020
Dim OfficeFolder As String
Dim PathToFolder As String
Dim TestStr As String

    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
        'You can use this msgbox line for testing if you want
        'MsgBox "You find the new folder in this location :" & PathToFolder
    End If
    CreateFolderinMacOffice = PathToFolder
End Function