How to Print/Save an Excel file using a macro

FashionGal

New Member
Joined
Mar 24, 2019
Messages
5
Hello,

I want to create a macro that allows me to physically print an excel spreadsheet and then automatically saves the spreadsheet as a PDF file in a particular location at the same time. The file name is unique to the information that is located in 2 various cells - T3 and L32. I will need to change some information on the sheet and will need to print/save the file multiple times and when it saves, I do not want the saved file to be overwritten with any new changes. Is there a way if there is already a file with that name to add a 01, 02, 03, etc. to the end of the file name automatically? Below is the macro that I have been using to print the excel sheet to paper and the macro that I have been using to save the excel sheet as a PDF. Any help would be greatly appreciated as I am new to creating macros.

Printing the File Macro
Sub PrintPaper()

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

End Sub

Saving the File as a PDF Macro
Sub PTPDF2()


Dim pdfName As String, FullName As String, Path As String

pdfName = Sheets("Award Sheet").Range("T3").Value
Path = "I:\Student Awarding\2019-20\APPEALS"
FullName = Path & pdfName & ".pdf"

Application.ScreenUpdating = False

ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName, OpenAfterPublish:=False

Application.ScreenUpdating = True

End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hi FashionGal,

Please when you post code next time use the code tags as shown below in blue/red (you can create them automatically by pressing the code icon # in the toolbar of the post window)

Rich (BB code):
Option Explicit


'//////////////////////////////////////////////
'// Print sheets and save version of workbook//
'//////////////////////////////////////////////
Sub PrintNSave()
    PrintPaper
    PTPDF2
    
End Sub


'//////////////////////////////////////////////
'// Printing the selected sheets to hard copy//
'//////////////////////////////////////////////
Private Sub PrintPaper()


    ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
                                         Collate:=True, _
                                         IgnorePrintAreas:=False


End Sub


'//////////////////////////////////////////////
'// Saving the File as a PDF with a          //
'// sequential number.                       //
'//////////////////////////////////////////////
Private Sub PTPDF2()
    Dim sPdfName As String, sFullName As String, sPath As String
    
    sPdfName = Sheets("Award Sheet").Range("T3").Value
    sPath = "I:\Student Awarding\2019-20\APPEALS"
    sFullName = GetNextFilename(sPath, sPdfName, ".pdf")
    
    Application.ScreenUpdating = False
    
    ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName, OpenAfterPublish:=False
    
    Application.ScreenUpdating = True


End Sub


'//////////////////////////////////////////////
'// Return the next sequenced filename to be //
'// used. Searches the given directory for   //
'// files with the same base name and checks //
'// the index numbers.                       //
'//////////////////////////////////////////////
Private Function GetNextFilename(sPath As String, sBaseName As String, sExt As String) As String
    Dim sMyFile As String
    Dim sExtension As String, sNumb As String
    Dim iSeq As Integer, iBN As Integer, iNext As Integer
    
    iBN = Len(sBaseName)
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    If Left(sExt, 1) <> "." Then sExt = "." & sExt
    
    'Target File Extension (must include wildcard "*")
      sExtension = sBaseName & "*" & sExt
    
    'Target Path with Ending Extention
      sMyFile = Dir(sPath & sExtension)
    
    'Loop through each Excel file in folder
    Do While sMyFile <> ""
        'check the file names
        sNumb = Trim(Mid(sMyFile, iBN + 1, Len(sMyFile) - (iBN + 5)))
        'catch error in case extended name is not numerical
        If IsNumeric(sNumb) Then
            iSeq = sNumb
            If iSeq > iNext Then iNext = iSeq
        End If


        'Get next file name
        sMyFile = Dir
    Loop
    GetNextFilename = sBaseName & (iNext + 1)
    
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,194
Members
448,554
Latest member
Gleisner2

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