Question

我正在尝试创建一个.pdf并将名为“ TELECOM”的工作表的打印区域从单元格“ A1”设置到数据表的最后一行。根据工作表“ TELECOM”上的单元格值，我希望相应地命名文件名。工作表“页眉信息”中的初始目录，单元格D11。然后，我抓取该初始目录（根据D列中其他单元格上的给定信息），然后将其转到更具体的目录。

我曾经尝试使用ExportAsFixedFormat和Type：= xlTypePDF之类的命令，但收效甚微。

Sub MakeaPDF()
Dim LstRw As Long
Dim Rng As Range
Dim wSheet As Worksheet
Set wSheet = ThisWorkbook.Sheets("TELECOM")
With Sheets("TELECOM")
Set wSheet = Sheets("TELECOM")
    LstRw = Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("A1:F" & LstRw)
    ThisWorkbook.Sheets("Header Info").PageSetup.PrintArea = Rng.Address
        If .Range("A1").Value = "30% Design Review" Then
        Sheets("Header Info").ExportAsFixedFormat , Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Header Info").Range("D11") & "\Design\_Common\Transmittals\30% DESIGN REVIEW\COMM\" & ThisWorkbook.Sheets("Header Info").Range("D14") & "_" & ThisWorkbook.Sheets("Header Info").Range("D15") & "_" & ThisWorkbook.Sheets("Header Info").Range("D18") & "_" & "COMM" & "_" & "30%_Design_Review_Xmittal.pdf"
        ElseIf .Range("A1").Value = "Final Design Review" Then
        Sheets("Header Info").ExportAsFixedFormat , Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Header Info").Range("D11") & "\Design\_Common\Transmittals\FINAL DESIGN REVIEW\COMM\" & ThisWorkbook.Sheets("Header Info").Range("D14") & "_" & ThisWorkbook.Sheets("Header Info").Range("D15") & "_" & ThisWorkbook.Sheets("Header Info").Range("D18") & "_" & "COMM" & "_" & "Final_Design_Review_Xmittal.pdf"
        ElseIf .Range("A1").Value = "Construction Submittal" Then
        Sheets("Header Info").ExportAsFixedFormat , Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Header Info").Range("D11") & "\Design\_Common\Transmittals\FINAL ISSUE\COMM\" & ThisWorkbook.Sheets("Header Info").Range("D14") & "_" & ThisWorkbook.Sheets("Header Info").Range("D15") & "_" & ThisWorkbook.Sheets("Header Info").Range("D18") & "_" & "COMM" & "_" & "Final_Issue_Xmittal.pdf"
        End If
End With
End Sub

我想在相应的文件夹中创建一个.pdf。

Answer 1

要检查的主要内容是（要导出到的）文件夹已经存在，并且文件名有效。我的支票可能涵盖了一些常见情况，但并不详尽。

Option Explicit

Sub MakeaPDF()

    Dim telecomSheet As Worksheet
    Set telecomSheet = ThisWorkbook.Worksheets("TELECOM") ' Change sheet's codename and use that instead maybe?

    Dim headerInfoSheet As Worksheet
    Set headerInfoSheet = ThisWorkbook.Worksheets("Header Info")

    Dim lastRowOnTelecomSheet As Long
    lastRowOnTelecomSheet = telecomSheet.Cells(telecomSheet.Rows.Count, "A").End(xlUp).Row

    ' Could you export the range/selection of cells -- rather than assiging the print area?
    headerInfoSheet.PageSetup.PrintArea = telecomSheet.Range("A1:F" & lastRowOnTelecomSheet).Address

    Dim folderPathStartsWith As String
    folderPathStartsWith = headerInfoSheet.Range("D11") & "\Design\_Common\Transmittals\"

    Dim folderPathEndsWith As String
    Dim filenameEndsWith As String

    Select Case LCase$(headerInfoSheet.Range("A1"))
        Case "30% design review"
            folderPathEndsWith = "30% DESIGN REVIEW\COMM\"
            filenameEndsWith = "30%_Design_Review_Xmittal.pdf"
        Case "final design review"
            folderPathEndsWith = "FINAL DESIGN REVIEW\COMM\"
            filenameEndsWith = "Final_Design_Review_Xmittal.pdf"
        Case "construction submittal"
            folderPathEndsWith = "FINAL ISSUE\COMM\"
            filenameEndsWith = "Final_Issue_Xmittal.pdf"
        Case Else
            MsgBox "Could not determine folder and filename of export. Code will stop running now to prevent unpredictable behaviour."
            Exit Sub
    End Select

    Dim folderPath As String
    folderPath = folderPathStartsWith & folderPathEndsWith

    If Len(Dir$(folderPath, vbDirectory)) = 0 Then
        MsgBox "'" & folderPath & "' is not a valid directory. Code will stop running now."
        Exit Sub ' Or you could create the directory here, if it doesn't exist, with MkDir
    End If

    With headerInfoSheet
        Dim pdfFilename As String
        pdfFilename = .Range("D14") & "_" & .Range("D15") & "_" & .Range("D18") & "_" & "COMM" & "_" & filenameEndsWith
    End With

    ' You may need to try to check if the filename is valid (if it's not, you may get an error when you go to export it)
    If StringContainsReservedCharacters(pdfFilename) Or Len(pdfFilename) > 260 Then
        ' Or you could replace any illegal characters with a legal character
        MsgBox "'" & pdfFilename & "' doesn't appear to be a valid filename. Code will stop running now."
        Exit Sub
    End If

    headerInfoSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=folderPath & pdfFilename
End Sub

Private Function StringContainsReservedCharacters(ByVal stringToCheck As String) As Boolean
    Const RESERVED_CHARACTERS As String = "<>:""/\|?*" 'https://docs.microsoft.com/en-us/windows/desktop/FileIO/naming-a-file
    Dim characterIndex As Long
    For characterIndex = 1 To Len(RESERVED_CHARACTERS)
        If InStr(1, stringToCheck, Mid$(RESERVED_CHARACTERS, characterIndex, 1), vbBinaryCompare) > 0 Then
            StringContainsReservedCharacters = True
            Exit Function
        End If
    Next characterIndex
End Function

如果遇到MsgBox，希望您会知道为什么它不起作用。

Answer 2

Sub MakePDF()

    Dim Répertoire As String
    Dim Fichier As String

    Dim Sheet1 As Worksheet
    Dim LstRw As Long
    Dim Rng As Range

    Set Sheet1 = Sheets("TELECOM")
    LstRw = Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("A1:F" & LstRw)


    'Put your repertory
    Répertoire = ""


    If Worksheets("Header info").Range("A1").Value = "30% Design Review" Then

        Fichier = ThisWorkbook.Sheets("Header Info").Range("D11") & "\Design\_Common\Transmittals\30% DESIGN REVIEW\COMM\" & ThisWorkbook.Sheets("Header Info").Range("D14") & "_" & ThisWorkbook.Sheets("Header Info").Range("D15") & "_" & ThisWorkbook.Sheets("Header Info").Range("D18") & "_" & "COMM" & "_" & "30%_Design_Review_Xmittal.pdf"
    Else
        If Worksheets("Header info").Range("A1").Value = "Final Design Review" Then
            Fichier = ThisWorkbook.Sheets("Header Info").Range("D11") & "\Design\_Common\Transmittals\FINAL DESIGN REVIEW\COMM\" & ThisWorkbook.Sheets("Header Info").Range("D14") & "_" & ThisWorkbook.Sheets("Header Info").Range("D15") & "_" & ThisWorkbook.Sheets("Header Info").Range("D18") & "_" & "COMM" & "_" & "Final_Design_Review_Xmittal.pdf"
        Else
            If Worksheets("Header info").Range("A1").Value = "Construction Submittal" Then
                Fichier = ThisWorkbook.Sheets("Header Info").Range("D11") & "\Design\_Common\Transmittals\FINAL ISSUE\COMM\" & ThisWorkbook.Sheets("Header Info").Range("D14") & "_" & ThisWorkbook.Sheets("Header Info").Range("D15") & "_" & ThisWorkbook.Sheets("Header Info").Range("D18") & "_" & "COMM" & "_" & "Final_Issue_Xmittal.pdf"
            End If
        End If
    End If


    Sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Répertoire & Fichier, _
        OpenAfterPublish:=True

End Sub

根据上一张表更改文件路径

2 个答案: