Save as PDF Macro working for Windows but not MAC OS

[jhirst001]

I am new to VBA and have found several solutions to creating a form control button that works on Windows OS. currently, it is able to work on my personal PC as well as co-workers using Windows OS. Where I have run into trouble is getting this to work for co-workers using a Mac device. Any help adapting this code to work for our resident Mac users is greatly appreciated.

The goal is for the Mac user to click the "save as PDF" button and have it save to their local downloads folder.

The code:

 Sub PDFActiveSheet()
        'www.contextures.com
        'for Excel 2010 and later
        Dim wsA As Worksheet
        Dim wbA As Workbook
        Dim strTime As String
        Dim strName As String
        Dim ID As String
        Dim strPath As String
        Dim strFile As String
        Dim strPathFile As String
        Dim myFile As Variant
        On Error GoTo errHandler
        
        ID = Range("A2")
        Set wbA = ActiveWorkbook
        Set wsA = ActiveSheet
        strTime = Format(Now(), "mmmm")
        
        'get active workbook folder, if saved
        strPath = wbA.Path
        If strPath = "" Then
          strPath = Application.DefaultFilePath
        End If
        strPath = strPath & "\"
        
        'replace spaces and periods in sheet name
        strName = Replace(wsA.Name, " ", "")
        strName = Replace(strName, ".", "_")
        
        'create default name for savng file
        strFile = ID & "_" & strName & "_" & strTime & ".pdf"
        strPathFile = strPath & strFile
        
        'use can enter name and
        ' select folder for file
        myFile = Application.GetSaveAsFilename _
            (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")
        
        'export to PDF if a folder was selected
        If myFile <> "False" Then
            wsA.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=myFile, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            'confirmation message with file info
            MsgBox "PDF file has been created: " _
              & vbCrLf _
              & myFile
              
        End If
        
exitHandler:
            Exit Sub
errHandler:
            MsgBox "Could not create PDF file"
            Resume exitHandler
        End Sub

 

[jhirst001]

I would suggest retrieving the OS name

Dim TheOS As String
TheOS = Application.Operatingsystem

and having one line of code when the name contains "Windows" and another when it does not (for Mac). The code will work fine without FileFilter, just shows the users more files.

Success.

The button now works on both Mac OS Windows OS.

This "win" came with a caveat though. On both Mac and Windows the file saves straight to the users 'Documents' folder (which I am fine with), BUT the file name no longer contains the the contents of cell A2 or the current month, as it previously had. So instead of saving as "Athletes Name_2-WeekTrainingSummary_January.pdf". it is saving as "Affiliate-Training-Tracker2023_".

I am happy to walk away with it working as is, but thought I would share the new code to see it you can see what might be causing it to lose its "variability", if you will.

  Sub PDFActiveSheet()
        'www.contextures.com
        'for Excel 2010 and later
        Dim wsA As Worksheet
        Dim wbA As Workbook
        Dim strTime As String
        Dim strName As String
        Dim ID As String
        Dim strPath As String
        Dim strFile As String
        Dim strPathFile As String
        Dim myFile As Variant
        Dim TheOS As String
        'On Error GoTo errHandler
        
        ID = Range("A2")
        Set wbA = ActiveWorkbook
        Set wsA = ActiveSheet
        strTime = Format(Now(), "mmmm")
        TheOS = Application.OperatingSystem
        
        'get active workbook folder, if saved
        strPath = wbA.Path
        If strPath = "" Then
          strPath = Application.DefaultFilePath
        End If
        strPath = strPath & Application.PathSeparator
        
        'replace spaces and periods in sheet name
        strName = Replace(wsA.Name, " ", "")
        strName = Replace(strName, ".", "_")
        
        'create default name for savng file
        strFile = ID & "_" & strName & "_" & strTime & ".pdf"
        strPathFile = strPath & strFile
        
        'use can enter name and
        ' select folder for file
        
        If TheOS = "Windows" Then
        
        myFile = Application.GetSaveAsFilename _
            (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")
        End If
        
        If TheOS = "Mac" Then
            myFile = Application.MacGetSaveAsFilenameExcel _
            (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")
        End If
        
        'export to PDF if a folder was selected
        If myFile <> "False" Then
            wsA.ExportAsFixedFormat Type:=xlTypePDF, _
                FileName:=myFile, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            'confirmation message with file info
            MsgBox "PDF file has been created: " _
              & vbCrLf _
              & myFile
              
        End If
        
exitHandler:
            Exit Sub
errHandler:
            MsgBox "Could not create PDF file"
            Resume exitHandler
        End Sub

 

[6StringJazzer]

The ID and month are the initial values for the name but the user selects whatever name they want. Those values are not forced to be part of the final file name.

TheOS will not be "Mac" or "Windows". It will be a string that looks like this
Windows (64-bit) NT 10.00
I'm not sure how your code works at all. myFile should end up being blank in this code, because neither If statement is TRUE. I would be doing this:

        If InStr(TheOS, "Windows") > 0 Then
        
           myFile = Application.GetSaveAsFilename _
               (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")

        Else

            myFile = Application.MacGetSaveAsFilenameExcel _
               (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")

        End If

But where is MacGetSaveAsFilenameExcel defined? That is not available on my system.

 

[jhirst001]

The ID and month are the initial values for the name but the user selects whatever name they want. Those values are not forced to be part of the final file name.

TheOS will not be "Mac" or "Windows". It will be a string that looks like this
Windows (64-bit) NT 10.00
I'm not sure how your code works at all. myFile should end up being blank in this code, because neither If statement is TRUE. I would be doing this:

        If InStr(TheOS, "Windows") > 0 Then
      
           myFile = Application.GetSaveAsFilename _
               (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")

        Else

            myFile = Application.MacGetSaveAsFilenameExcel _
               (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")

        End If

But where is MacGetSaveAsFilenameExcel defined? That is not available on my system.

That's interesting that it spit out a PDF with code that shouldn't work... loopholes maybe lol.

I tried replacing what I had with your code and the Mac user was no longer able to use the button.

He got Run-time error '438': object doesnt support this property or method

After selecting debug, it highlighted the line of code after "Else". Suggesting, what you have already mentioned, FileFilter not being necessary, or MacGetSaveAsFilenameExcel not being defined?

To be honest, I dont know where MacGetSaveAsFilenameExcel is defined... I took it from the Mac Excel Automation site you shared and crossed my fingers that I picked the right thing.

 

[6StringJazzer]

To be honest, I dont know where MacGetSaveAsFilenameExcel is defined... I took it from the Mac Excel Automation site you shared and crossed my fingers that I picked the right thing.

There is no such thing as Application.MacGetSaveAsFilenameExcel. That does not appear in the code on that site. If you read all the code on that page you will see that the author wrote MacGetSaveAsFilenameExcel as a custom function. That function is provided on the page. You need to copy that function and include it as a function in your own code.

 

[jhirst001]

There is no such thing as Application.MacGetSaveAsFilenameExcel. That does not appear in the code on that site. If you read all the code on that page you will see that the author wrote MacGetSaveAsFilenameExcel as a custom function. That function is provided on the page. You need to copy that function and include it as a function in your own code.

Okay, after some trial and error we have gotten it to work on both systems.

The Mac user has to change the name of the document and change the file type from .xlxs to .pdf, but both of these things are a non-issue.

I appreciate your help and patience!

The code:

Function MacGetSaveAsFilenameExcel(MyInitialFilename As String, FileExtension As String)
'Ron de Bruin, 03-April-2015
'Custom function for the Mac to save the activeworkbook in the format you want.
'If FileExtension = "" you can save in the following formats : xls, xlsx, xlsm, xlsb
'You can also set FileExtension to the extension you want like "xlsx" for example
    Dim FName As Variant
    Dim FileFormatValue As Long
    Dim TestIfOpen As Workbook
    Dim FileExtGetSaveAsFilename As String

Again: FName = False
    
    'Call VBA GetSaveAsFilename
    'Note: InitialFilename is the only parameter that works on a Mac
    FName = Application.GetSaveAsFilename(InitialFileName:=MyInitialFilename)

    If FName <> False Then
        'Get the file extension
        FileExtGetSaveAsFilename = LCase(Right(FName, Len(FName) - InStrRev(FName, ".", , 1)))

        If FileExtension <> "" Then
            If FileExtension <> FileExtGetSaveAsFilename Then
                MsgBox "Sorry you must save the file in this format : " & FileExtension
                GoTo Again
            End If
            If ActiveWorkbook.HasVBProject = True And LCase(FileExtension) = "PDF" Then
                MsgBox "Your workbook have VBA code, please not save in xlsx format"
                Exit Function
            End If
        Else
            If ActiveWorkbook.HasVBProject = True And LCase(FileExtGetSaveAsFilename) = "PDF" Then
                MsgBox "Your workbook have VBA code, please not save in xlsx format"
                GoTo Again
            End If
        End If

        'Find the correct FileFormat that match the choice in the "Save as type" list
        'and set the FileFormatValue, Extension and FileFormatValue must match.
        'Note : You can add or delete items to/from the list below if you want.
        Select Case FileExtGetSaveAsFilename
        Case "xls": FileFormatValue = 57
        Case "xlsx": FileFormatValue = 52
        Case "xlsm": FileFormatValue = 53
        Case "xlsb": FileFormatValue = 51
        Case Else: FileFormatValue = 0
        End Select
        If FileFormatValue = 0 Then
            MsgBox "Sorry, FileFormat not allowed"
            GoTo Again
        Else
            'Error check if there is a file open with that name
            Set TestIfOpen = Nothing
            On Error Resume Next
            Set TestIfOpen = Workbooks(LCase(Right(FName, Len(FName) - InStrRev(FName, _
                Application.PathSeparator, , 1))))
            On Error GoTo 0

            If Not TestIfOpen Is Nothing Then
                MsgBox "You are not allowed to overwrite a file that is open with the same name, " & _
                "use a different name or close the file with the same name first."
                GoTo Again
            End If
        End If

        'Now we have the information to Save the file
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.SaveAs FName, FileFormat:=FileFormatValue
        On Error GoTo 0
        Application.DisplayAlerts = True
    End If

End Function
  
  Sub PDFActiveSheet()
        'www.contextures.com
        'for Excel 2010 and later
        Dim wsA As Worksheet
        Dim wbA As Workbook
        Dim strTime As String
        Dim strName As String
        Dim ID As String
        Dim strPath As String
        Dim strFile As String
        Dim strPathFile As String
        Dim myFile As Variant
        Dim TheOS As String
        'On Error GoTo errHandler
        
        ID = Range("A2")
        Set wbA = ActiveWorkbook
        Set wsA = ActiveSheet
        strTime = Format(Now(), "mmmm")
        TheOS = Application.OperatingSystem
        
        'get active workbook folder, if saved
        strPath = wbA.Path
        If strPath = "" Then
          strPath = Application.DefaultFilePath
        End If
        strPath = strPath & Application.PathSeparator
        
        'replace spaces and periods in sheet name
        strName = Replace(wsA.Name, " ", "")
        strName = Replace(strName, ".", "_")
        
        'create default name for savng file
        strFile = ID & "_" & strName & "_" & strTime & ".pdf"
        strPathFile = strPath & strFile
        
        'use can enter name and
        ' select folder for file
        
        If InStr(TheOS, "Windows") > 0 Then
        
           myFile = Application.GetSaveAsFilename _
               (InitialFileName:=strPathFile, _
                FileFilter:="PDF Files (*.pdf), *.pdf", _
                Title:="Select Folder and FileName to save")

        Else

            myFile = Application.GetSaveAsFilename _

        End If
        
        'export to PDF if a folder was selected
        If myFile <> "False" Then
            wsA.ExportAsFixedFormat Type:=xlTypePDF, _
                FileName:=myFile, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            'confirmation message with file info
            MsgBox "PDF file has been created: " _
              & vbCrLf _
              & myFile

        End If
        
exitHandler:
            Exit Sub
errHandler:
            MsgBox "Could not create PDF file"
            Resume exitHandler
        End Sub

 

[ful28361]

Good evening, and thanks for your help. is possible to use this code with some modify for to save CSV format? Thanks thanks