VBA 使用最后一个表列作为文件名将每个表行打印为 pdf

Question

我需要将每个表行（表1）的详细信息导出为pdf，为每个导出的行设置表1[学生ID]列中的文件名。 最好从导出中排除行中的空白单元格。

作为初学者，我拥有搜索

类似问题所需的大部分逻辑元素，但对 VBA 的本机顺序感到困惑。

最后一栏【学生证】必须是pdf文件名才能上传文件。

Sub ExportTableRowToPDF()

Dim ws As Worksheet
Dim tbl As ListObject
Dim rw As ListRow
Dim pdfFile As String

Set ws = ThisWorkbook.Sheets("Sheet1")
Set tbl = ws.ListObjects("Table1")

For Each rw In tbl.ListRows

If Application.WorksheetFunction.countA(rw.Range) > 0 Then

pdfFile = rw.Range.Cells(1, tbl.ListColumns.Count).Value & ".pdf"

rw.Range.Copy
ws.Range("A1").Select
ActiveSheet.PageSetup.PrintArea = rw.Range.Address & ":" & rw.Range.Cells(1, tbl.ListColumns.Count).Address
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End If

Next rw

End Sub

Answer 1

Excel 表格行转 PDF

Sub ExportTableRowsToPDF()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim pdfFolderPath As String: pdfFolderPath = wb.Path ' !?
    
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    Dim tbl As ListObject: Set tbl = ws.ListObjects("Table1")
    ' This allows the column to be anywhere.
    Dim lc As ListColumn: Set lc = tbl.ListColumns("StudentID")
    
    ' Reference the whole and the criteria range.
    Dim rg As Range: Set rg = tbl.DataBodyRange
    Dim crg As Range: Set crg = lc.DataBodyRange ' or 'rg.Columns(lc.Index)'
    ' or 'rg.Columns(rg.Columns.Count)' for the last column
    
    ' Determine the number of columns that must not be blank.
    ' Assuming the criteria column is not counted ('- 1').
    Dim ColumnsCount As Long: ColumnsCount = rg.Columns.Count - 1
    
    ' Export only if the criteria cell contains no error, is not blank,
    ' and if at least one column other than the criteria column is populated.
    
    Dim Value As Variant, r As Long, pdfPath As String
    Dim IsRowValid As Boolean, WasRowExported As Boolean
    
    For r = 1 To rg.Rows.Count
        Value = crg.Cells(r).Value
        IsRowValid = False
        If Not IsError(Value) Then ' not an error
            If Len(Value) > 0 Then ' not blank
                ' If it is enough that there is a valid criteria (student id),
                ' without any other column populated, you don't need
                ' 'ColumnsCount' (above) and the following 'If' statement.
                If Application.CountBlank(rg.Rows(r)) < ColumnsCount Then
                    IsRowValid = True
                End If
            End If
        End If
        If IsRowValid Then
            pdfPath = pdfFolderPath & Application.PathSeparator & Value & ".pdf"
            WasRowExported = False
            On Error Resume Next
                rg.Rows(r).ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=pdfPath, Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=True, _
                    OpenAfterPublish:=False
                WasRowExported = (Err.Number = 0)
            On Error GoTo 0
            If Not WasRowExported Then
                MsgBox "Could not export as """ & pdfPath & """!", vbExclamation
            End If
        End If
    Next r

    MsgBox "Rows exported.", vbInformation

End Sub