I'm in a bit of fix here as this code works perfectly for windows [my own OS]. The aim of the code is to save a particular worksheet in a filename each time. If the directory doesn't exist, it will also create the directory to store the filename.
However, when tried on a MacOS, it just produces an error. No PDF gets created or saved. It simply manages to highlight the area to save to PDF. That's all.
Any ideas?
Sub SaveSelectionAsPDF()
Dim saveLocation As String
Dim CheckOS, PoNumber As String
Dim RememberFirstRow, RememberLastRow As Integer
Dim saveDirectory As String
Worksheets("PO_Formatted").Activate
CheckOS = Application.OperatingSystem
PoNumber = Cells(11, 3).Value
If InStr(1, CheckOS, "Windows") > 0 Then
saveDirectory = "C:\Users\" & Environ("username") & "\Desktop\PO Sheets\" & Format(Date, "dd-mmm-yyyy") & "\"
saveLocation = "C:\Users\" & Environ("username") & "\Desktop\PO Sheets\" & Format(Date, "dd-mmm-yyyy") & "\" & Cells(11, 3).Value & ".pdf"
Call CreateDir(saveDirectory)
Else
saveLocation = "/Users/username/Desktop/" & Cells(11, 3).Value & ".pdf"
End If
Range("B1000").Select
Selection.End(xlUp).Select
Range(ActiveCell.Offset(1, -1), Cells(1, 10)).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation, OpenAfterPublish:=True
Worksheets("PO_Sheet").Activate
For i = 4 To ActiveSheet.UsedRange.Rows.Count
If Cells(i, 4).Value = PoNumber Then
Cells(i, 21).Value = "Confirmed"
End If
Next i
Worksheets("PO_Formatted").Activate
End Sub
Sub CreateDir(strPath As String)
Dim elm As Variant
Dim strCheckPath As String
strCheckPath = ""
For Each elm In Split(strPath, "\")
strCheckPath = strCheckPath & elm & "\"
If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath
Next
End Sub
So it works perfectly on Windows, but not MacOS, where it just produces an error. No PDF gets created or saved. It simply manages to highlight the area to save to PDF. That's all.
Option Explicit
Sub ExportRangeToPDF()
Dim pSep As String: pSep = Application.PathSeparator
Dim FolderPath As String: FolderPath = Environ("USERPROFILE") _
& pSep & "Desktop" & pSep & "PO Sheets" & pSep _
& Format(Date, "dd-mmm-yyyy")
CreateFolder FolderPath
'ThisWorkbook.FollowHyperlink FolderPath ' explore the folder
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim fws As Worksheet: Set fws = wb.Sheets("PO_Formatted")
Dim frg As Range: Set frg = fws.Range("J1", _
fws.Cells(fws.Rows.Count, "B").End(xlUp).Offset(1, -1)) ' ? 1 = 0 ?
Dim PoNumber As String: PoNumber = fws.Range("C11").Value
Dim FilePath As String: FilePath = FolderPath & pSep & PoNumber & ".pdf"
frg.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, _
OpenAfterPublish:=True
Dim sws As Worksheet: Set sws = wb.Sheets("PO_Sheet")
Dim r As Long
For r = 4 To sws.UsedRange.Rows.Count
If CStr(sws.Cells(r, "D").Value) = PoNumber Then
sws.Cells(r, "U").Value = "Confirmed"
End If
Next r
MsgBox "Range exported to PDF.", vbInformation
End Sub
Create Folder
Sub CreateFolder(ByVal FolderPath As String)
Dim pSep As String: pSep = Application.PathSeparator
Do While Right(FolderPath, 1) = pSep ' remove trailing path separators
FolderPath = Left(FolderPath, Len(FolderPath) - 1)
Loop
Dim SplitPath() As String: SplitPath = Split(FolderPath, pSep)
Dim n As Long, JoinedPath As String
Do While Len(SplitPath(n)) = 0 ' handle leading path separators
JoinedPath = JoinedPath & pSep
n = n + 1
Loop
For n = n To UBound(SplitPath)
JoinedPath = JoinedPath & SplitPath(n) & pSep
If Len(Dir(JoinedPath, vbDirectory)) = 0 Then MkDir JoinedPath
Next n
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With