生成 PDF 时删除列 VBA

Question

我有一个 excel 文件，其模板看起来像这样。

我根据 客户 ID 列 筛选记录并将它们保存为单独的 Pdf's.I 我正在使用下面的 VBA 代码来完成这项工作。

Public Sub Create_PDFs()

    Dim CustomerIDsDict As Object, CustomerID As Variant
    Dim r As Long
    Dim currentAutoFilterMode As Boolean
    
    Set CustomerIDsDict = CreateObject("Scripting.Dictionary")
    
    'The code looks at data on the active sheet
    
    With ActiveSheet
    
        'Save current UI autofilter mode
        
        currentAutoFilterMode = .AutoFilterMode
        
        If currentAutoFilterMode Then .AutoFilter.ShowAllData
       
        'Create dictionary containing unique Customer IDs (column B) and associated Country (column B), keyed on Customer ID
        
        For r = 5 To .Cells(.Rows.Count, "B").End(xlUp).Row
            CustomerIDsDict(.Cells(r, "B").Value) = .Cells(r, "C").Value
        Next
        
        'For each unique Customer ID
        
        For Each CustomerID In CustomerIDsDict.keys
            
            'AutoFilter on column B (Field:=2) with this Customer ID
            
            '.UsedRange.AutoFilter Field:=2, Criteria1:=CustomerID
             With .Range("A3")
                .AutoFilter Field:=2, Criteria1:=CustomerID
                .Rows(2).EntireRow.Hidden = False
             End With

            'Save filtered data as PDF file "<Customer ID> <Country>.pdf" in same folder as this workbook
            
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & CustomerID & " " & CustomerIDsDict(CustomerID) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                    
        Next
    
        'Restore previous autofilter, if any
    
        If currentAutoFilterMode Then
            .AutoFilter.ShowAllData
        Else
            .AutoFilterMode = False
        End If
        
    End With
    
End Sub

但是某些 CustomerID 在最后六列中没有任何值。即New volume Qty,New volume price这几栏。在生成 PDF 之前，我想检查这些列，如果有任何记录作为值，那么我们可以显示这些列，否则不需要在 Pdf 文件中显示它们。

例如：

如果您看到此 CustomerID，它在列 New Volume qty2,3,4 和 New Volume Price 2,3,4 中没有任何值，所以在这种情况下我不希望这些列显示在这个特定客户 ID 的 PDF 中。

而在下面的客户 ID 中

只有新卷数量 3,4 和新卷价格 3,4 没有价值。所以我想在将它们保存为 PDF 之前只删除这些列。

Headers 对于上述列

有什么方法可以使用上面的脚本来做到这一点。谁能帮我解决这个问题。

Answer 1

请测试下一个代码。您没有回答我的澄清问题，它允许创建要检查的列范围。然后，创建这些列编号的数组 (arrCols)，检查每个此类列中是否没有任何值，并将它们的单元格放在一个范围内 (rngHd)，对于这种情况。然后，在导出前隐藏它们并在导出后使它们可见：

Public Sub Create_PDFs()
    Dim CustomerIDsDict As Object, CustomerID As Variant
    Dim r As Long, currentAutoFilterMode As Boolean
    Dim strCols As String, rngHd As Range, lastR As Long, arrCols, i As Long, iRow As Long
    
    strCols = "O:V": arrCols = Evaluate("column(" & strCols & ")") 'place in an array the columns to be checked number
    iRow = 5
    Set CustomerIDsDict = CreateObject("Scripting.Dictionary")
    
    'The code looks at data on the active sheet
    With ActiveSheet
        lastR = .Range("A" & .Rows.count).End(xlUp).row 'last row in A:A
        
        'Save current UI autofilter mode
        currentAutoFilterMode = .AutoFilterMode
        If currentAutoFilterMode Then .AutoFilter.ShowAllData
       
        'Create dictionary containing unique Customer IDs (column B) and associated Country (column B), keyed on Customer ID
        For r = 5 To .cells(.Rows.count, "B").End(xlUp).row
            CustomerIDsDict(.cells(r, "B").Value) = .cells(r, "C").Value
        Next
        
        'For each unique Customer ID
        For Each CustomerID In CustomerIDsDict.Keys
            
            'AutoFilter on column B (Field:=2) with this Customer ID
             With .Range("A3")
                .AutoFilter field:=2, Criteria1:=CustomerID
                .Rows(2).EntireRow.Hidden = False
             End With
             
             'place the empty columns one cell in a Union range
             For i = 1 To UBound(arrCols)
                 If WorksheetFunction.CountA(.Range(.cells(iRow, arrCols(i)), .cells(lastR, arrCols(i))).SpecialCells(xlCellTypeVisible)) = 0 Then
                     If rngHd Is Nothing Then
                        Set rngHd = .cells(3, arrCols(i))
                     Else
                        Set rngHd = Union(rngHd, .cells(3, arrCols(i)))
                     End If
                 End If
            Next i
            'Hide the empty columns, if the case:
            If Not rngHd Is Nothing Then rngHd.EntireColumn.Hidden = True
            
            'Save filtered data as PDF file "<Customer ID> <Country>.pdf" in same folder as this workbook
            .ExportAsFixedFormat Type:=xlTypePDF, filename:=ThisWorkbook.Path & "\" & CustomerID & " " & CustomerIDsDict(CustomerID) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                
            rngHd.EntireColumn.Hidden = False 'make all checked columns visible
            Set rngHd = Nothing                    'reSet the range as Nothing for the future iterations
        Next
    
        'Restore previous autofilter, if any
        If currentAutoFilterMode Then
            .AutoFilter.ShowAllData
        Else
            .AutoFilterMode = False
        End If
        
    End With
End Sub

对于已隐藏列的情况没有错误处理。理论上，这种情况在正常使用中是不会出现的。之前可以检查列的可见性...

生成 PDF 时删除列 VBA

Remove columns when generating PDF VBA

pdf

excel

vba