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
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,695
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:

Watch MrExcel Video

Forum statistics

Threads
1,112,787
Messages
5,542,511
Members
410,559
Latest member
jordansmith6532
Top