How to print out PDF file from hyperlinks from an Excel spreadsheet

[RastaBomboclat]

Hi all,

I have an Excel file with VBA code that allows me, on a click of a button, to choose a folder and display on the active sheet, all the files in it (including those in sub-folders). Said files are listed on column B of the sheet in hyperlink, so that by clicking on a hyperlink, the related file open (display). They are almost all PDF files.

My need is to have a button which, when clicked, will print all the PDFs of these hyperlinks. My problem is here: printing those files. If there are 100 lines, printing them one by one would be really tiring and time consuming. I will lose efficiency and productivity.

Can you help me by finding / scripting a VBA code that can do that? This same code could help, I think, many other Internet users in the same situation.

Here is the code I use to display the hyperlinks pdf on the Excel spreadsheet:

Option Explicit

Dim dossier_origine As String
Dim ligne_ecrire As Long

With Application.FileDialog(msoFileDialogFolderPicker)

    .Title = "Select the folder to be scan"
    .Show

    If .SelectedItems.Count > 0 Then

        dossier_origine = .SelectedItems(1)

    Else

        Exit Sub

    End If

End With

Sheets("resultat_scan").Cells.Clear

Call lister_fichiers(dossier_origine, ActiveSheet.Name)

Application.ScreenUpdating = True

MsgBox "Scan well done", vbInformation, _
        "RastaBomboclat"

End Sub
Sub lister_fichiers(dossier_cours As String, feuille_destination As String)

Dim FSO As Scripting.FileSystemObject
Dim objet_dossier As Scripting.Folder
Dim objet_sous_dossier As Scripting.Folder
Dim objet_fichier As Scripting.File
Dim ligne_ecrire As Long
Dim nom_fichier_cours As String
Dim nom_dossier_sans_espaces As String
Dim nom_fichier_sans_espaces As String
Dim ligne_resultats As Long

'
Application.ScreenUpdating = False
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objet_dossier = FSO.GetFolder(dossier_cours)
'
ligne_ecrire = Sheets(feuille_destination).Range("A1048576").End(xlUp).Row + 1
'
nom_dossier_sans_espaces = Replace(objet_dossier.Path, " ", "%20")
'
'
Sheets(feuille_destination).Range("A" & ligne_ecrire).Hyperlinks.Add Anchor:=Sheets(feuille_destination).Range("A" & ligne_ecrire), Address:=nom_dossier_sans_espaces, TextToDisplay:=objet_dossier.Name
Sheets(feuille_destination).Range("A" & ligne_ecrire).Font.Bold = True
'
Sheets(feuille_destination).Range("B" & ligne_ecrire) = NombreFichiers(objet_dossier)
'
Sheets(feuille_destination).Range("C" & ligne_ecrire) = Sheets(feuille_destination).Range("B" & ligne_ecrire).Value * 4
'
'Sheets(feuille_destination).Range("D" & ligne_ecrire) = objet_dossier.ParentFolder.Name
Sheets(feuille_destination).Range("D" & ligne_ecrire) = objet_dossier.ParentFolder.Name & " => " & objet_dossier.Name

ligne_ecrire = ligne_ecrire + 1

'Loop on all files in the folder
For Each objet_fichier In objet_dossier.Files

    nom_fichier_cours = objet_fichier.Name

    nom_fichier_sans_espaces = Replace(objet_fichier.Name, " ", "%20")

    Sheets(feuille_destination).Range("A" & ligne_ecrire) = objet_dossier.Name
    Sheets(feuille_destination).Range("B" & ligne_ecrire).Hyperlinks.Add Anchor:=Sheets(feuille_destination).Range("B" & ligne_ecrire), Address:=nom_dossier_sans_espaces & "\" & nom_fichier_sans_espaces, TextToDisplay:=objet_fichier.Name
    Sheets(feuille_destination).Range("C" & ligne_ecrire) = objet_fichier.Type

    ligne_ecrire = ligne_ecrire + 1

    Sheets(feuille_destination).Range("A" & ligne_ecrire).Value = "Column-A"
    Sheets(feuille_destination).Range("A" & ligne_ecrire).Font.Bold = True
    '
    Sheets(feuille_destination).Range("B" & ligne_ecrire).Value = "Column-B"
    Sheets(feuille_destination).Range("B" & ligne_ecrire).Font.Bold = True
    '
    Sheets(feuille_destination).Range("C" & ligne_ecrire).Value = "Column-C"
    Sheets(feuille_destination).Range("C" & ligne_ecrire).Font.Bold = True
    '

Next objet_fichier

'--- Callback to subfolder ---
For Each objet_sous_dossier In objet_dossier.SubFolders

    Call lister_fichiers(objet_sous_dossier.Path, feuille_destination)

Next objet_sous_dossier

Range("D5:D10000").Select
With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlCenter
    .Font.Bold = True
End With
Columns("D:D").EntireColumn.AutoFit
Range("A1").Select

Application.ScreenUpdating = True

End Sub

Function NombreFichiers(ByVal Pasta As String) As Long
    Dim FSO As Object

    Set FSO = CreateObject("Scripting.filesystemobject")
    NombreFichiers = FSO.GetFolder(Pasta).Files.Count

    Set FSO = Nothing
End Function

 

[RastaBomboclat]

 

[John_w]

But I don't use the Hyperlink function, so only the file name is displayed in the formula bar

Not a problem, because my code handles both types of hyperlink: those created using Hyperlinks.Add or inserted manually using the link dialogue, and those created with the HYPERLINK cell function.

Can you please try to do a test on your side with my one that I sent to you (the 1st code I sent), just to see what it looks like for you with your solution. Maybe we will manage to solve this isue?

Sorry, but your code is specific to your sheet layout and name, etc. so I can't really test it.

Your screenshot above shows the first hyperlink is in B3, however the code starts at B2. Therefore, change:

        For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row

to:

        For r = 3 To .Cells(.Rows.Count, "B").End(xlUp).Row