VB Script to Save Results to a single PDF Fila

amkkhan

Board Regular
Joined
Dec 11, 2021
Messages
75
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
this small VBA Chunk iterates from roll no 1 to last i(collecting data from sheet1 and getting results.
but unfortunately, it prints only the last result instead of all the iterated results.
All I want is just to export all the iterated results into a single pdf file on the said path.


VBA Code:
Sub printPDF()
For n = 5 To 15
RollNo = Sheets("Sheet1").Cells(n, "A")
StudentName = Sheets("Sheet1").Cells(n, "C")
Sheets("Results").Cells(13, "M") = RollNo
Next
Sheet7.ExportAsFixedFormat xlTypePDF, "C:\result\" & RollNo & "-" & StudentName & ".pdf", , , False, , , False
End Sub
 
Hi amkkhan,

the original code I used:

VBA Code:
Sub printPDF_mod2()
Dim lngRow As Long
Dim strTempName As String
Dim wks As Worksheet

strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

Application.ScreenUpdating = False
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = strTempName & Worksheets.Count
  End With
Next lngRow
 
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
Worksheets(Worksheets.Count).Activate

ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False '

Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With

End Sub
Please check in Backstage when in PrintPreview if you see anything displayed. If not change to Print Active Sheets and see if data is displayed.

Or give this code a try:
VBA Code:
Sub printPDF_mod3()
Dim lngRow As Long
Dim strTempName As String
Dim wks As Worksheet

strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

Application.ScreenUpdating = False
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = strTempName & Worksheets.Count
  End With
Next lngRow
 
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
Worksheets(Worksheets.Count).Activate

'ActiveSheet.ExportAsFixedFormat _
'    Type:=xlTypePDF, _
'    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
'    Quality:=xlQualityStandard, _
'    IncludeDocProperties:=True, _
'    IgnorePrintAreas:=False, _
'    OpenAfterPublish:=False '
ActiveWindow.SelectedSheets.PrintOut ActivePrinter:="Microsoft Print to PDF", _
                                      PrintToFile:=True, _
                                      PrToFileName:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf"

Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With

End Sub
Ciao,
Holger
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi amkkhan,

the original code I used:

VBA Code:
Sub printPDF_mod2()
Dim lngRow As Long
Dim strTempName As String
Dim wks As Worksheet

strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

Application.ScreenUpdating = False
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = strTempName & Worksheets.Count
  End With
Next lngRow
 
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
Worksheets(Worksheets.Count).Activate

ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False '

Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With

End Sub
Please check in Backstage when in PrintPreview if you see anything displayed. If not change to Print Active Sheets and see if data is displayed.

Or give this code a try:
VBA Code:
Sub printPDF_mod3()
Dim lngRow As Long
Dim strTempName As String
Dim wks As Worksheet

strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

Application.ScreenUpdating = False
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = strTempName & Worksheets.Count
  End With
Next lngRow
 
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
Worksheets(Worksheets.Count).Activate

'ActiveSheet.ExportAsFixedFormat _
'    Type:=xlTypePDF, _
'    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
'    Quality:=xlQualityStandard, _
'    IncludeDocProperties:=True, _
'    IgnorePrintAreas:=False, _
'    OpenAfterPublish:=False '
ActiveWindow.SelectedSheets.PrintOut ActivePrinter:="Microsoft Print to PDF", _
                                      PrintToFile:=True, _
                                      PrToFileName:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf"

Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With

End Sub
Ciao,
Holger
hi @HaHoBe Thanks.
I given too many tries to both of these scripts but unfortunately both are publishing Single pdf file but with Null Information
I did some effort on my own and succeeded little bit. Let me explain what I am getting.
The code below is publishing Current Student on 1st page and rest of the plages Blank

VBA Code:
Sub printPDF()
Dim lngRow As Long
Dim strTempName As String
Dim wks As Worksheet

strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

Application.ScreenUpdating = False
For lngRow = 5 To 15
  With Sheets("Sheet1")
    
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    'ActiveSheet.Name = strTempName & Worksheets.Count
  End With
  ActiveSheet.Name = strTempName & Worksheets.Count
Next lngRow
 
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
Worksheets(Worksheets.Count).Activate

ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False '

Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With
End Sub

And the The code below is publishing Same information of currently displayed student on all the pages
Code:
Sub printPDF()
Dim lngRow As Long
Dim strTempName As String
Dim wks As Worksheet

strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

Application.ScreenUpdating = False
For lngRow = 5 To 15
  With Sheets("Sheet1")
    'Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    'ActiveSheet.Name = strTempName & Worksheets.Count
  End With
  ActiveSheet.Name = strTempName & Worksheets.Count
Next lngRow
 
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
Worksheets(Worksheets.Count).Activate

ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False '

Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With
End Sub

What I was expecting is that Script should Scroll the Cell M13 on "Results" Sheet from 1 to n and publish all the iterated/Scrolled pages into pdf file.

Thanks
 
Upvote 0
Hi amkkhan,

regarding #12 Code 1:

VBA Code:
'The code below is publishing Current Student on 1st page and rest of the plages Blank
'/// copying sheet before altering information, so first sheet should hold information
'/// prior to copying.
'/// I do not have a clue why the first sheet shows information with the others being blanks
'/// Is there any event-code in ThisWorkbook or behind the sheets in question (Sheet1 and Result)?
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    'ActiveSheet.Name = strTempName & Worksheets.Count
  End With
  ActiveSheet.Name = strTempName & Worksheets.Count
Next lngRow

Regarding #12 Code 2:

VBA Code:
'The code below is publishing Current Student on 1st page and rest of the plages Blank
'/// copying sheet before altering information, so first sheet should hold information
'/// prior to copying.
'/// I do not have a clue why the first sheet shows information with the others being blanks
'/// Is there any event-code in ThisWorkbook or behind the sheets in question (Sheet1 and Result)?
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    'ActiveSheet.Name = strTempName & Worksheets.Count
  End With
  ActiveSheet.Name = strTempName & Worksheets.Count
Next lngRow

As I am unable to see your settings for Printer I would kindly ask you to check if the information is transformed correctly to the sheets and these are named like wanted. What does the PrintPreview show when you use it still having the new sheets in the workbook? Is there any change in altering the setting for what to print?

Holger
 
Upvote 0
Hi amkkhan,

regarding #12 Code 1:

VBA Code:
'The code below is publishing Current Student on 1st page and rest of the plages Blank
'/// copying sheet before altering information, so first sheet should hold information
'/// prior to copying.
'/// I do not have a clue why the first sheet shows information with the others being blanks
'/// Is there any event-code in ThisWorkbook or behind the sheets in question (Sheet1 and Result)?
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    'ActiveSheet.Name = strTempName & Worksheets.Count
  End With
  ActiveSheet.Name = strTempName & Worksheets.Count
Next lngRow

Regarding #12 Code 2:

VBA Code:
'The code below is publishing Current Student on 1st page and rest of the plages Blank
'/// copying sheet before altering information, so first sheet should hold information
'/// prior to copying.
'/// I do not have a clue why the first sheet shows information with the others being blanks
'/// Is there any event-code in ThisWorkbook or behind the sheets in question (Sheet1 and Result)?
For lngRow = 5 To 15
  With Sheets("Sheet1")
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    'ActiveSheet.Name = strTempName & Worksheets.Count
  End With
  ActiveSheet.Name = strTempName & Worksheets.Count
Next lngRow

As I am unable to see your settings for Printer I would kindly ask you to check if the information is transformed correctly to the sheets and these are named like wanted. What does the PrintPreview show when you use it still having the new sheets in the workbook? Is there any change in altering the setting for what to print?

Holger
Is it possible that I could share the file. Because I am totally new to VBA and don't understand even a single line of VBA,
XL2BB is not helping because i have multiple sheets that are transferring data to the final Sheet.
 
Upvote 0
Hi amkkhan,

you could upload the workbook to a free filehosting service (e.g. dropbox), there is no direct possibility to do so in this Forum.

Holger
 
Upvote 0
Hi amkkhan,

you could upload the workbook to a free filehosting service (e.g. dropbox), there is no direct possibility to do so in this Forum.

Holger
Is it OK to share Dropbox link here?
 
Upvote 0
Hi amkkhan,

as far as I know yes - I have seen such before and posted links to OneDrive by myself.

Hokger
 
Upvote 0
Hi amkkhan,

I put in comments to describe what the lines are supposed to do and added a boolean to decide whether to delete the copied sheets or not. At present this boolean is set to False to keep the sheets for control - especially to check if the blank pages are due to settings for the printer. Another Sub should take care and delete these sheets, this should work for the same month:

VBA Code:
Sub MrE_1222829_161490E_Update_printPDF()
' https://www.mrexcel.com/board/threads/vb-script-to-save-results-to-a-single-pdf-fila.1222829/
' Created: 20221122
' By:      HaHoBe
' Version: 2
' Updated: 20221125
' Reason:  Code commented

Dim lngRow                      As Long               'counter for looping through the rows
Dim strTempName                 As String             'used as left of name for copied sheets
Dim wks                         As Worksheet          'object to cycle through all worksheets

Const cblnDeleteTempSheets      As Boolean = False    'boolean to decide whether to delete the
                                                      'copied sheets or hold them for control

'/// setting the left part of the new sheetname
strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

'/// turning the update for display off for speed
Application.ScreenUpdating = False
'/// working from start to last as indicated
For lngRow = 5 To 15
  With Sheets("Sheet1")
    '/// transfer the value from Sheet1 Column I and row as per looper to
    '/// Sheets Result in given cell M13
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    '/// copy Sheets Result to the end of the sheets
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    '/// assigning the new name consisting of left part and Number of Worksheets in Workbook
    ActiveSheet.Name = strTempName & Worksheets.Count
  End With
Next lngRow

'/// loop through all worksheets in workbook
For Each wks In Worksheets
  With wks
    '/// check if the name starts with the temp name, if so, start grouping
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
'/// make sure that the activesheet is part of the grouping so activate the last worksheet
Worksheets(Worksheets.Count).Activate

'/// using the next command says export the active sheet to PDF,
'/// since we have grouped them the array of sheets is chosen instead
ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False '
'ActiveWindow.SelectedSheets.PrintOut ActivePrinter:="Microsoft Print to PDF", _
                                      PrintToFile:=True, _
                                      PrToFileName:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf"

'/// for control of what is actually visible on the sheets the deletion of sheets
'/// will only take place if the bollean is set to True
If cblnDeleteTempSheets Then
  '/// turn off the information about deletio of sheets
  Application.DisplayAlerts = False
  '/// loop through all worksheets in workbook
  For Each wks In Worksheets
    With wks
    '/// check if the name starts with the temp name, if so, delete sheet
      If Left(.Name, Len(strTempName)) = strTempName Then .Delete
    End With
  Next wks
End If

'/// turn on information and screenupdating
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With

End Sub

VBA Code:
Public Sub MrE_1222829_161490E_DeleteTempSheets()
' https://www.mrexcel.com/board/threads/vb-script-to-save-results-to-a-single-pdf-fila.1222829/
'/// for deleting any sheets left over for control
Dim strTempName     As String

strTempName = "Test " & Format(Date, "yyyymm")
Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks

End Sub

HTH,
Holger
 
Upvote 0
Hi amkkhan,

I put in comments to describe what the lines are supposed to do and added a boolean to decide whether to delete the copied sheets or not. At present this boolean is set to False to keep the sheets for control - especially to check if the blank pages are due to settings for the printer. Another Sub should take care and delete these sheets, this should work for the same month:

VBA Code:
Sub MrE_1222829_161490E_Update_printPDF()
' https://www.mrexcel.com/board/threads/vb-script-to-save-results-to-a-single-pdf-fila.1222829/
' Created: 20221122
' By:      HaHoBe
' Version: 2
' Updated: 20221125
' Reason:  Code commented

Dim lngRow                      As Long               'counter for looping through the rows
Dim strTempName                 As String             'used as left of name for copied sheets
Dim wks                         As Worksheet          'object to cycle through all worksheets

Const cblnDeleteTempSheets      As Boolean = False    'boolean to decide whether to delete the
                                                      'copied sheets or hold them for control

'/// setting the left part of the new sheetname
strTempName = "Test " & Format(Date, "yyyymmdd") & " - "

'/// turning the update for display off for speed
Application.ScreenUpdating = False
'/// working from start to last as indicated
For lngRow = 5 To 15
  With Sheets("Sheet1")
    '/// transfer the value from Sheet1 Column I and row as per looper to
    '/// Sheets Result in given cell M13
    Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
    '/// copy Sheets Result to the end of the sheets
    Sheets("Results").Copy after:=Sheets(Sheets.Count)
    '/// assigning the new name consisting of left part and Number of Worksheets in Workbook
    ActiveSheet.Name = strTempName & Worksheets.Count
  End With
Next lngRow

'/// loop through all worksheets in workbook
For Each wks In Worksheets
  With wks
    '/// check if the name starts with the temp name, if so, start grouping
    If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
  End With
Next wks
'/// make sure that the activesheet is part of the grouping so activate the last worksheet
Worksheets(Worksheets.Count).Activate

'/// using the next command says export the active sheet to PDF,
'/// since we have grouped them the array of sheets is chosen instead
ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False '
'ActiveWindow.SelectedSheets.PrintOut ActivePrinter:="Microsoft Print to PDF", _
                                      PrintToFile:=True, _
                                      PrToFileName:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf"

'/// for control of what is actually visible on the sheets the deletion of sheets
'/// will only take place if the bollean is set to True
If cblnDeleteTempSheets Then
  '/// turn off the information about deletio of sheets
  Application.DisplayAlerts = False
  '/// loop through all worksheets in workbook
  For Each wks In Worksheets
    With wks
    '/// check if the name starts with the temp name, if so, delete sheet
      If Left(.Name, Len(strTempName)) = strTempName Then .Delete
    End With
  Next wks
End If

'/// turn on information and screenupdating
With Application
  .DisplayAlerts = True
  .ScreenUpdating = False
End With

End Sub

VBA Code:
Public Sub MrE_1222829_161490E_DeleteTempSheets()
' https://www.mrexcel.com/board/threads/vb-script-to-save-results-to-a-single-pdf-fila.1222829/
'/// for deleting any sheets left over for control
Dim strTempName     As String

strTempName = "Test " & Format(Date, "yyyymm")
Application.DisplayAlerts = False
For Each wks In Worksheets
  With wks
    If Left(.Name, Len(strTempName)) = strTempName Then .Delete
  End With
Next wks

End Sub

HTH,
Holger
Here is the link to file.
you will have to create a folder with name "Result" in your drive C.

Rest you better know
I want to get a single pdf file for all students
if file name is same as the excel file name and preceeded by word "Result - " it would be complimentary
 
Upvote 0
Here is the link to file.
you will have to create a folder with name "Result" in your drive C.

Rest you better know
I want to get a single pdf file for all students
if file name is same as the excel file name and preceeded by word "Result - " it would be complimentary
I am expecting script to print only pages that have data and it may ignore blank sheets.

Thanks @HaHoBe
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top