Bonjour ce tuto a été très enrichissant et je vous suis très reconnaissant.

Fin de la sous-section

  Dim wb As Workbook, feuille As Worksheet

  Dim plage As String, nomDocument As String, dossierAdresse As String

  Dim iVis As XlSheetVisibility

Définir wb = ThisWorkbook

Set feuille = wb. Feuilles(« Devis »)

dossierAdresse = Sheets(« Paramètres »). Gamme(« K9 »). Valeur & « \ »

nomDocument = feuille. Gamme(« J10 »). Valeur

  ‘Mettre à plage l adresse de la plage à imprimer

plage = « $C$6:$M$53 »

  Application.ScreenUpdating = False

Avec feuille. PageSetup

. PrintArea = plage

. FitToPagesTall = 1

. FitToPagesWide = 1′ Définissez FitToPagesWide sur 1

. LeftMargin = Application.InchesToPoints(0)

. RightMargin = Application.InchesToPoints(0)

. TopMargin = Application.InchesToPoints(0)

. BottomMargin = Application.InchesToPoints(0)

Terminez par

Avec feuille

iVis = . Visible

. Visible = xlSheetVisible

. Activer

. Type ExportAsFixedFormat :=xlTypePDF, _

Nom de fichier:=dossierAdresse & nomDocument & « .pdf », _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=False, OpenAfterPublish:=True

. Visible = iVis

Terminez par

Application.ScreenUpdating = Vrai

Fin de la sous-section

Je vous prie de m’aider a trouver une correction a la partie entre guillemets. Merci

This works so much easier!

This macro is saved in my Personal.xlsb file and is attached as a QuickAccess button.

Sub macExportToPDF()

'
' Modernized version of 'macPrintToPDF' macro, no longer uses PDFCreator
'
' More info at: https://powerspreadsheets.com/save-excel-file-pdf-vba/#Parameter-3-Quality
'
' macExportToPDF Macro
' Use in-built ability to save Print Range to PDF
' Uses workbook FileName to save on user's Desktop
'

Dim sPath, FileNameToSave

    'Set path to user's DESKTOP
    sPath = Environ("USERPROFILE") & "\Desktop\"
    
    'Get workbook filename, including extension
    FileNameToSave = ActiveWorkbook.Name
    
    'Strip extension
    FileNameToSave = Left(FileNameToSave, InStrRev(FileNameToSave, ".") - 1)
    
    'Set final name to SaveAs
    FileNameToSave = sPath & FileNameToSave & ".pdf"
        
    'Publish to Desktop
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=FileNameToSave, _
        Quality:=xlQualityStandard, _
        OpenAfterPublish:=False, _
        IgnorePrintAreas:=False
        
End Sub

I have kids with different logins, with different desktop, just wondering if you could help with path to save.

Filename:=ActiveWorkbook.Path & “” & ActiveSheet.Range(“F5”).Value, _
where I cud to save to a folder “%systemdrive%%users%%currant User%DesktopMaths”

Many Thanks

I am using

Sub Save_Excel_As_PDF_7()
With ActiveSheet.PageSetup
.Orientation = xlPortrait
End With

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ActiveWorkbook.Path & “” & ActiveSheet.Range(“F5”).Value, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
From:=1, _
to:=5, _
OpenAfterPublish:=True
End Sub

Would you be willing to advise how to add one more element into your code: printing only visible sheets, please? (I am customising and building on top of example 8).
In my workbook in question, some sheets are previously turned .xlVeryHidden by a macro, as they are only assisting sheets and should not be seen by the end-user / workbook reader.
Is there a way I can make sure these do not get printed into the PDF?
Thank you very much.
Alice

Hi Jorge,
Your article was amazing and very informative.
I would like to add an addendum to squishysdomain’s question.
The difference is that I have certain pages using page breaks in the sheets. What I need is, i need to have only the 5th page from the first sheet, 4th page for the second sheet, 6th page from the third sheet and so on, for a couple of sheets and then combine them into one PDF file.

I have searched everywhere for a solution for this type of a situation but in vain!!

I’d appreciate any solution 🙂

Hi Jorge.

Sorry for my late reply. I was able to find and fix the problems with my macro, thanks to your help and your very helpful arcticle. Many thanks!

My macro, actually, needs to highlight the header cell and the cell in the column to the left of the first column, to indicate the position of the active cell. Also, before highlighting the next selected cell, it needs to clear the previously highlighted cells.
https://uploads.disquscdn.com/images/7a88d2e1cdc2a7c6503e2eccd03f1bfd704c9a34b987669792fa385b32b43953.png https://uploads.disquscdn.com/images/61b5690134f9f9e30f54dd2005fb7c88a253afcaa7f5351bd21c1ccefe610c40.png
Sub Worksheet_SelectionChange(ByVal Target As Range)

‘Macro to highlight row and column of active cell

Application.ScreenUpdating = False

iChange = False

‘Loop through tables to clear highlighted cells
For iCounter = 1 To ActiveSheet.ListObjects.Count

With ActiveSheet.ListObjects(iCounter)

‘get header row range
iHeaderRange = .HeaderRowRange.Address

‘get first body cell
iBodyFirstCellColNum = .DataBodyRange(1, 1).Column ‘as a number

‘Clear interior color of previously highlighted cells
Range(iHeaderRange).Interior.ColorIndex = xlColorIndexNone
Columns(iBodyFirstCellColNum).Offset(0, -1).Interior.ColorIndex = xlColorIndexNone

End With

Next iCounter

‘Loop through first and penultimate tables
For iCounterMod = 1 To ActiveSheet.ListObjects.Count – 1

With ActiveSheet.ListObjects(iCounterMod)

‘get first header row
iHeaderRow = .HeaderRowRange(1).Row

‘get body range
iBodyRange = .DataBodyRange.Address
‘get first body cell
iBodyFirstCellColNum = .DataBodyRange(1, 1).Column ‘as a number

‘Get column index of selected cell
Col = ActiveCell.Column
‘Get row index of selected cell
Row = ActiveCell.Row

End With

‘if you select more than 1 cell, sub ends
If Target.Cells.CountLarge > 1 Then Exit Sub

‘if you selected a body cell
If Not Intersect(Target, Me.Range(iBodyRange)) Is Nothing Then

‘iChange = True, i.e., some cells in first and penultimate tables were highlighted
iChange = True

‘Check if you are in an odd line
If (Row Mod 2 = 0 And iHeaderRow Mod 2 = 0) Or (Row Mod 2 0 And iHeaderRow Mod 2 0) Then

‘Highlight cells
Cells(Row, iBodyFirstCellColNum).Offset(0, -1).Interior.ColorIndex = 37
Cells(Row – 1, iBodyFirstCellColNum).Offset(0, -1).Interior.ColorIndex = 37
Cells(iHeaderRow, Col).Interior.ColorIndex = 37

Else

‘Highlight cells
Cells(Row, iBodyFirstCellColNum).Offset(0, -1).Interior.ColorIndex = 37
Cells(Row + 1, iBodyFirstCellColNum).Offset(0, -1).Interior.ColorIndex = 37
Cells(iHeaderRow, Col).Interior.ColorIndex = 37

End If

‘if iChange = True (i.e., some cells in first and penultimate tables were highlighted), exit for loop
If iChange Then Exit For

End If

Next iCounterMod

‘if iChange = False (i.e., no cells in first and penultimate tables were highlighted), go to last table
If Not iChange Then

‘Loop through last table
For iCounterVeh = ActiveSheet.ListObjects.Count To ActiveSheet.ListObjects.Count

With ActiveSheet.ListObjects(iCounterVeh)

‘get first header row
iHeaderRow = .HeaderRowRange(1).Row

‘get body range
iBodyRange = .DataBodyRange.Address
‘get first body cell
iBodyFirstCellColNum = .DataBodyRange(1, 1).Column ‘as a number

‘Get column index of selected cell
Col = ActiveCell.Column
‘Get row index of selected cell
Row = ActiveCell.Row

End With

If Target.Cells.Count > 1 Then Exit Sub ‘If you select more than 1 cell, sub ends

If Not Intersect(Target, Me.Range(iBodyRange)) Is Nothing Then ‘If you selected a body cell

‘Highlight cells
Cells(Row, iBodyFirstCellColNum).Offset(0, -1).Interior.ColorIndex = 37
Cells(iHeaderRow, Col).Interior.ColorIndex = 37

End If

Next iCounterVeh

End If

Application.ScreenUpdating = True

End Sub

It worked perfectly! I’ve just made some adjustments.

Many thanks!!!

https://uploads.disquscdn.com/images/4d599e0175d8eb0cb244e0920a614de1a4ff933da1ffdc5198058c8302a18a82.png