Printing Multiple PDF Files and Saving with Different Filenames

djicenine

New Member
Joined
Mar 16, 2016
Messages
10
Hi All!

I have an Excel macro to print music bingo cards that does the following:


  • Randomly chooses 25 songs from a list of x number of songs, fills in the cells of a 5x5 grid
  • Refreshes the card, which again chooses 25 random song title to fill the card
  • Repeats based on the quantity I choose

Instead of sending these to the printer each time I would like to have them print to a PDF file and save them to a folder. I would like the files to be named Bingo Card 1.pdf, Bingo Card 2.pdf etc. I would like to amend my original macro below, to accomplish this:

Sub BingoPrint()


' Refresh page and print x number of times
Application.ScreenUpdating = False
x = InputBox("How many sheets do you require printing?")
For Card = 1 To x
Calculate


'Amend the range to reflect your bingo card
Range("B3:H16").PrintOut
Next Card
Application.ScreenUpdating = True


End Sub

Any help on this would be greatly appreciate! Thank you very much!

Patrick
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
.
Create a folder on your desktop named Bingo Cards.

The following will create as many pdf copies as you indicate. It will also ask for a name for the pdf file.

An example for creating 3 copies of a card named Bingo 1, would result in the following pdf copies in the Bingo Cards folder :

Bingo 1 1
Bingo 1 2
Bingo 1 3


Code:
Option Explicit


Sub BingoPrint()
Dim x As Integer
Dim y As String
Dim Card


' Refresh page and print x number of times
Application.ScreenUpdating = False
x = InputBox("How many sheets do you require printing?", "Total To Print ?")
y = InputBox("Name of Card ?", "Card Name")
For Card = 1 To x
Calculate




'Amend the range to reflect your bingo card
Sheets("Sheet1").Range("A1:E5").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "C:\Users\" & Environ("username") & "\Desktop\Bingo Cards\" & y & " " & Card & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
Next Card
Application.ScreenUpdating = True




End Sub
 
Upvote 0
Thanks so much for your reply, Logit!

I tried the code and got a run-time error 9 - "Subscript out of Range" on this part:Sheets("Sheet1").Range("B3:H16").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users" & Environ("username") & "\Desktop\Bingo Cards" & y & " " & Card & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

OpenAfterPublish:=True

The only thing I did was change the range to match the print area of my original macro. Just to make sure we are on the same page, I want to make sure that you know that I need each card to be completely unique. So, if I tell the macro to print 60 cards, it will refresh then print to pdf and save as Card1. Then refresh to make the card unique, and save the second card as "Card2" etc.

Any further ideas would be great! Thanks again!

Patrick
 
Upvote 0
.
The only thing that might cause that error is the name of the sheet. With a slight alteration to the code,
try this. NOTE: Your bingo card layout must be on Sheet1 or you'll need to change the code to reflect
the correct sheet.

When the code refers to Sheet1, that is the code name of the sheet, not the TAB NAME.

Code:
Option Explicit


Sub BingoPrint()
Dim x As Integer
Dim y As String
Dim num As Integer


' Refresh page and print x number of times
Application.ScreenUpdating = False
x = InputBox("How many sheets do you require printing?", "Total To Print ?")
y = "Card "
For num = 1 To x
Calculate




'Amend the range to reflect your bingo card
Sheet1.Range("A1:E5").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "C:\Users\" & Environ("username") & "\Desktop\Bingo Cards\" & y & " " & num & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
Next num
Application.ScreenUpdating = True




End Sub
 
Upvote 0
Logit,

AMAZING! This worked perfectly! Thank you so much for your help! This is a Godsend!

Have a great day!

Patrick
 
Upvote 0

Forum statistics

Threads
1,214,611
Messages
6,120,510
Members
448,967
Latest member
screechyboy79

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