Save all versions of data validation to one PDF

[Whitmore]

I have a worksheet named 'RAG' that creates individual sheets for each student.

currently I have the code below that prints each validation. However, I'm looking at a way to have option to save it as one PDF document.
I will want to be able to choose file path and name at point of save.

Any brilliant minds out there that can help?

for information - the validation list length changes depending on how many names are entered on a number page.

Sub Print_all()
Dim xRg As Range
Dim xCell As Range
Dim xRgVList As Range
Set xRg = Worksheets("RAG").Range("C2")
Set xRgVList = Evaluate(xRg.Validation.Formula1)
For Each xCell In xRgVList
xRg = xCell.Value
ActiveSheet.PrintOut

Next
End Sub

 

[John_w]

I have a worksheet named 'RAG' that creates individual sheets for each student.

currently I have the code below that prints each validation. However, I'm looking at a way to have option to save it as one PDF document.
I will want to be able to choose file path and name at point of save.

Try this macro:

Public Sub Create_Multiple_Pages_PDF()

    Dim PDFfullName As Variant
    Dim PDFsheet As Worksheet, destCell As Range
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    
    PDFfullName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, _
                                                FileFilter:="PDF (*.pdf), *.pdf", _
                                                Title:="Save as PDF")
    If PDFfullName = False Then Exit Sub
    
    'Add temporary sheet for PDF output
    
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = PDFsheet.Range("A1")
    
    'Cell containing data validation in-cell dropdown

    Set dataValidationCell = ActiveWorkbook.Worksheets("RAG").Range("C2")
     
    'Source of data validation list
    
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
     
    'Set each value in the data validation cell
    
    For Each dvValueCell In dataValidationListSource
    
        dataValidationCell.Value = dvValueCell.Value
        
        'Copy sheet cells to next cell in temporary PDF sheet
        
        dataValidationCell.Worksheet.UsedRange.Copy
        destCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        destCell.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
        'Add page break and update destination cell
        
        With PDFsheet
            .HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
            Set destCell = .Cells(.UsedRange.Rows.Count + 1, 1)
        End With
    
    Next
    
    'Save temporary sheet as .pdf file
    
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    'Delete temporary sheet
    
    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[Whitmore]

Thank you for your reply, I'm now one step closer.

this line of code I had to remove as it was failing to complete the action due to merged cells.

 destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

It's almost perfect, but it's not using the set print area, meaning it's spread across a number of sheets, where I need one sheet per validation / print area

 

[John_w]

This revised macro should handle merged cells and it copies the print area to the PDF instead of the used range. It also copies cell formats, pictures, column widths and row heights.

Public Sub Create_Multiple_Pages_PDF2()

    Dim PDFfullName As Variant
    Dim PDFsheet As Worksheet, destCell As Range
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    Dim copyRange As Range
    
    PDFfullName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, _
                                                FileFilter:="PDF (*.pdf), *.pdf", _
                                                Title:="Save as PDF")
    If PDFfullName = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
    'Add temporary sheet for PDF output
    
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = Nothing
    
    'Cell containing data validation in-cell dropdown

    Set dataValidationCell = ActiveWorkbook.Worksheets("RAG").Range("C2")
     
    'Source of data validation list
    
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
     
    'Set each value in the data validation cell
    
    For Each dvValueCell In dataValidationListSource
    
        'The print area will be copied
        
        dataValidationCell.Value = dvValueCell.Value
        Set copyRange = dataValidationCell.Worksheet.Range(dataValidationCell.Worksheet.PageSetup.PrintArea)
        
        If destCell Is Nothing Then Set destCell = PDFsheet.Range(copyRange.Address)
            
        'Copy cells to destination cell in temporary PDF sheet
    
        copyRange.Copy
        
        With destCell
            .Select
            'Paste cells including formats, merged cells and pictures
            .Worksheet.Paste
            'Apply column widths
            .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'Change cells to values
            .Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
            'Use Format Painter to copy and paste row heights
            copyRange.EntireRow.Copy
            .Resize(copyRange.Rows.Count).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        
        'Add page break and update destination cell
        
        With PDFsheet
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With
    
    Next
    
    'Save temporary sheet as .pdf file
    
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    'Delete temporary sheet
    
    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    
End Sub

 

[ob1tech77]

This revised macro should handle merged cells and it copies the print area to the PDF instead of the used range. It also copies cell formats, pictures, column widths and row heights.

Public Sub Create_Multiple_Pages_PDF2()

    Dim PDFfullName As Variant
    Dim PDFsheet As Worksheet, destCell As Range
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    Dim copyRange As Range
   
    PDFfullName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, _
                                                FileFilter:="PDF (*.pdf), *.pdf", _
                                                Title:="Save as PDF")
    If PDFfullName = False Then Exit Sub
   
    Application.ScreenUpdating = False
   
    'Add temporary sheet for PDF output
   
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = Nothing
   
    'Cell containing data validation in-cell dropdown

    Set dataValidationCell = ActiveWorkbook.Worksheets("RAG").Range("C2")
    
    'Source of data validation list
   
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
    
    'Set each value in the data validation cell
   
    For Each dvValueCell In dataValidationListSource
   
        'The print area will be copied
       
        dataValidationCell.Value = dvValueCell.Value
        Set copyRange = dataValidationCell.Worksheet.Range(dataValidationCell.Worksheet.PageSetup.PrintArea)
       
        If destCell Is Nothing Then Set destCell = PDFsheet.Range(copyRange.Address)
           
        'Copy cells to destination cell in temporary PDF sheet
   
        copyRange.Copy
       
        With destCell
            .Select
            'Paste cells including formats, merged cells and pictures
            .Worksheet.Paste
            'Apply column widths
            .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'Change cells to values
            .Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
            'Use Format Painter to copy and paste row heights
            copyRange.EntireRow.Copy
            .Resize(copyRange.Rows.Count).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
       
        'Add page break and update destination cell
       
        With PDFsheet
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With
   
    Next
   
    'Save temporary sheet as .pdf file
   
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   
    'Delete temporary sheet
   
    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
   
    Application.ScreenUpdating = True
   
End Sub

Hello! I'm attempting to use this code and it seems to be working ok, but it's not staying within the Print Area. Any other suggestions as to why it might off.

Thank you for your help.

 

[John_w]

I'm attempting to use this code and it seems to be working ok, but it's not staying within the Print Area.

Replace:

        'Add page break and update destination cell
        
        With PDFsheet
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With

with:

        'Set or extend print area of temporary PDF sheet, add page break and update destination cell
        
    Dim printRange As Range

        With PDFsheet
            If .PageSetup.PrintArea = "" Then
                .PageSetup.PrintArea = copyRange.Address
            Else
                Set printRange = Range(.PageSetup.PrintArea)
                Set printRange = printRange.Resize(printRange.Rows.Count + copyRange.Rows.Count)
                .PageSetup.PrintArea = printRange.Address
            End If
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With

The new code sets the print area on the temporary PDF sheet to the same as the data range, extending it for each data validation value.