将工作表保存为 PDF 并在需要时创建目录，适用于 Windows 和 MacOS

我在这里进行了一些修复，因为这段代码非常适合 Windows [我自己的操作系统]。 该代码的目的是每次都以文件名保存特定的工作表。如果该目录不存在，它也会创建一个目录来存储文件名。

然而，当在 MacOS 上尝试时，它只会产生错误。不会创建或保存任何 PDF。它只是设法突出显示要保存到 PDF 的区域。就这样。

有任何想法吗？

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

因此它在 Windows 上完美运行，但在 MacOS 上则不然，它只会产生错误。不会创建或保存任何 PDF。它只是设法突出显示要保存到 PDF 的区域。就这样。

将范围导出为 PDF（适用于 Windows 和 MacOS）

• 我没有 Mac，所以非常欢迎任何反馈。

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

创建文件夹

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