Print all external workbooks in a folder location to PDF

[camerong]

Hi guys,

I'm after a VBA macro code that I can have saved in a workbook that, when run by pushing the macro button. Brings up a window where you can select a folder and it will find all excel workbooks in that location and print them to PDF. I would like the Print to pdf to only print used cells and scale it down so that the used columns all are on a single page. Page size A4, portrait. PDF filename to be the same as the excel document printed.

Thanks

 

[OaklandJim]

Option Explicit
Option Base 1


Sub WorkbooksInFolderAsPDFs()

'   Workbok object points to each workbook processed.
    Dim wbToPDF As Workbook
  
'   Worksheet object used to specify which worksheet to make into pdf.
    Dim wsToPDF As Worksheet
  
'   Name of the pdf file to save.
    Dim sFileNamePDF As String
  
'   Name of "thisworkbook" used so this workbook is not made into a pdf.
    Dim sThisworkbookName As String
  
'   Count of files found.
    Dim iFilesFound As Long
  
    Dim iFileIndex As Long
  
'   Path to and name of folder.
    Dim sPathAndFolder As String
  
'   Array that wil hold all file names in a folder.
    Dim asFiles() As String
  
'   Get this file's name...don't want to process it.
    sThisworkbookName = ThisWorkbook.Name
  
'   Get folder from user.
    sPathAndFolder = GetFolderFromUser()
  
'   Put name of all files found in the folder.
    Call FilesListToArray(sPathAndFolder, asFiles)
  
'   Get count of files found.
    iFilesFound = UBound(asFiles)
  
'   Add trailing slash if it is missing.
    If Right(sPathAndFolder, 1) <> "\" Then sPathAndFolder = sPathAndFolder & "\"
  
'   Iterate all files found in the folder.
    For iFileIndex = 1 To iFilesFound
  
'       Open the next workbook found in the folder. Apparently Dir returns
'       "phantom" file names -- for files that do not exiist -- that have to
'       be ignored. Those phantom file names include $and # characters.
        On Error GoTo Closeout
        Set wbToPDF = Workbooks.Open(sPathAndFolder & asFiles(iFileIndex))
      
'       Only process workbooks if they are not thisworkbook.
        If wbToPDF.Name <> sThisworkbookName _
        Then
      
'           Specify which worksheet to make into a pdf.
            Set wsToPDF = wbToPDF.Worksheets(1)
          
            sFileNamePDF = GetFileNameNoExt(wbToPDF.Name)
      
            With wsToPDF
          
'               Select the first worksheet in the workbook being processed.
                .Select
          
'               Do page setup: 1, portrait, 2. fit to one page wide, 3. A4.
                With .PageSetup
                  
                    .Orientation = xlPortrait
                    .PaperSize = xlPaperA4
                    .FitToPagesWide = 1
              
                End With
              
                wbToPDF.Save
              
                Call PDFWorksheet(wsToPDF, sPathAndFolder, sFileNamePDF)
      
            End With
          
            Application.DisplayAlerts = False
      
            wbToPDF.Close
      
        End If
  
    Next iFileIndex

Closeout:

End Sub

 

[OaklandJim]

I don't know what else to do. It works perfectly for me. Odd. Disappointing.

Here is the pdf that I just made with the code. PDF file

 

[OaklandJim]

There may be someone else on the list who knows other things to try. You can ask then refer readers to this thread using the url

Print all external workbooks in a folder location to PDF

Hi guys, I'm after a VBA macro code that I can have saved in a workbook that, when run by pushing the macro button. Brings up a window where you can select a folder and it will find all excel workbooks in that location and print them to PDF. I would like the Print to pdf to only print used...

www.mrexcel.com

Make it a link.

 

[camerong]

Ok thanks OaklandJim no worries

 

[OaklandJim]

I was really hoping to deliver a good product. I really disappointed. Oh well. I did my best.

 

[John_w]

Try this macro. It works OK on my test workbooks.

Public Sub Save_Workbooks_As_PDF_1_Page_Wide()

    Dim workbooksFolder As String
    Dim workbookFileName As String
    Dim wb As Workbook
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select folder containing workbooks to be saved as PDF"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath & "\"
        If Not .Show Then Exit Sub
        workbooksFolder = .SelectedItems(1) & "\"
    End With

    Application.ScreenUpdating = False
    
    workbookFileName = Dir(workbooksFolder & "*.xlsx")
    While workbookFileName <> vbNullString
        Set wb = Workbooks.Open(workbooksFolder & workbookFileName, UpdateLinks:=False, ReadOnly:=True)
        With wb.Worksheets(1).PageSetup
            Application.DisplayAlerts = False 'suppress warnings, including "You've selected a single cell for the print area."
            .PrintArea = wb.Worksheets(1).UsedRange.Address
            Application.DisplayAlerts = True
            Application.PrintCommunication = False
            .Orientation = xlPortrait
            .PaperSize = xlPaperA4
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 0
            Application.PrintCommunication = True
        End With
        wb.Worksheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=Replace(wb.FullName, ".xlsx", ".pdf", Compare:=vbTextCompare), _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        wb.Close SaveChanges:=False
        workbookFileName = Dir()
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

 

[camerong]

Hi John_w,

Thanks, that's bought it into 1 page wide. However we have an image at the top of the page that has the top half cut off in the pdf. Is there a way for it to always print from cell A1 down?

 

[John_w]

Delete:

            Application.DisplayAlerts = False 'suppress warnings, including "You've selected a single cell for the print area."
            .PrintArea = wb.Worksheets(1).UsedRange.Address
            Application.DisplayAlerts = True

 

[camerong]

Thanks John_w,

That works perfect