Macro for printing same form multiple times in pdf

[VTirolla]

Hello!

I am working in a tool to generate reports. I have created a form in one worksheet "Report" and when a change a cell values related to the tag, this form is be populated with the information related to that tag number.
I created the following code, but after the macro finish running, the pdf files are not saved anywhere.

NrTags is the total amount of reports that shall be printed.

Sub PrintWFCReport()
'
' PrintWFCReport Macro
' Prints the WFC Report for all Tags in .pdf file
'
Application.Calculation = xlAutomatic
Dim NrTags As Integer
Dim i As Integer
NrTags = Worksheets("Configurator").Range("B12").Value

Do
Worksheets("Report").Range("L3").Value = i
i = i + 1
Sheets("Report").Range("A1:I53").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\" & (Environ$("Username")) & "\Desktop\WFC Report - " & Sheets("Figures").Range("B3").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

Loop Until Worksheets("Report").Range("L3").Value = NrTags

Worksheets("Report").Range("L3").Value = 0
'
End Sub

The way this code should work is that i would get one report per tag. Also, if you can advise me in how to print all the reports in a single .pdf file it would be amazing!

Thanks!

 

[John_w]

The way this code should work is that i would get one report per tag. Also, if you can advise me in how to print all the reports in a single .pdf file it would be amazing!

Try this macro.

Public Sub Create_WFC_Report()

    Dim PDFfullName As String
    Dim PDFsheet As Worksheet
    Dim reportDestCell As Range, reportRange As Range
    Dim NrTags As Integer
    Dim i As Integer
    
    PDFfullName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\WFC Report.pdf"
   
    With ActiveWorkbook
   
        'Add temporary sheet for PDF output
       
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        Set reportDestCell = PDFsheet.Range("A1")
       
        'Range to be copied to temporary sheet for each report value
       
        Set reportRange = .Worksheets("Report").Range("A1:I53")
       
    End With
    
    NrTags = Worksheets("Configurator").Range("B12").Value
    i = 0
    Do
        Worksheets("Report").Range("L3").Value = i
        i = i + 1
        
        'Copy cell formats, column widths, the picture and cell values to next cell in temporary PDF sheet
       
        reportRange.Copy
        reportDestCell.Select
        reportDestCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        reportDestCell.Worksheet.Paste
        reportDestCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
        'Use Format Painter to apply row heights
       
        reportRange.EntireRow.Copy
        With PDFsheet
            .Range(reportDestCell, .Cells(.UsedRange.Rows.Count, 1)).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        
        'Add page break and update destination cell for next report
       
        With PDFsheet
            .HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
            Set reportDestCell = .Cells(.UsedRange.Rows.Count + 1, 1)
        End With
        
    Loop Until Worksheets("Report").Range("L3").Value = NrTags
    
    Worksheets("Report").Range("L3").Value = 0
       
    'Save temporary sheet as PDF then delete it
   
    With PDFsheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
    MsgBox "Created " & PDFfullName, vbInformation
   
End Sub

 

[VTirolla]

Try this macro.

Public Sub Create_WFC_Report()

    Dim PDFfullName As String
    Dim PDFsheet As Worksheet
    Dim reportDestCell As Range, reportRange As Range
    Dim NrTags As Integer
    Dim i As Integer
   
    PDFfullName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\WFC Report.pdf"
  
    With ActiveWorkbook
  
        'Add temporary sheet for PDF output
      
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        Set reportDestCell = PDFsheet.Range("A1")
      
        'Range to be copied to temporary sheet for each report value
      
        Set reportRange = .Worksheets("Report").Range("A1:I53")
      
    End With
   
    NrTags = Worksheets("Configurator").Range("B12").Value
    i = 0
    Do
        Worksheets("Report").Range("L3").Value = i
        i = i + 1
       
        'Copy cell formats, column widths, the picture and cell values to next cell in temporary PDF sheet
      
        reportRange.Copy
        reportDestCell.Select
        reportDestCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        reportDestCell.Worksheet.Paste
        reportDestCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
        'Use Format Painter to apply row heights
      
        reportRange.EntireRow.Copy
        With PDFsheet
            .Range(reportDestCell, .Cells(.UsedRange.Rows.Count, 1)).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
       
        'Add page break and update destination cell for next report
      
        With PDFsheet
            .HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
            Set reportDestCell = .Cells(.UsedRange.Rows.Count + 1, 1)
        End With
       
    Loop Until Worksheets("Report").Range("L3").Value = NrTags
   
    Worksheets("Report").Range("L3").Value = 0
      
    'Save temporary sheet as PDF then delete it
  
    With PDFsheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
   
    MsgBox "Created " & PDFfullName, vbInformation
  
End Sub

Thanks John, appreciate the help!