Save to pdf vba

[orsm6]

Hi all - many macros out there but struggling to find one that simply saves a range on a worksheet to pdf.

preferably just to desktop (or the macro will at least ask user where to save).
also needs to be able to work if the source book is located on a OneDrive if possible.

can anyone point me to a thread or share a code?

TIA

 

[Logit]

Option Explicit

Sub SaveSelectedRangeAsPdf()

'The generated PDF will be saved to the desktop

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "\OneDrive\Desktop\" & Format(Date, "mm-dd-yy") & ".pdf", OpenAfterPublish:=False

End Sub

 

[orsm6]

Option Explicit

Sub SaveSelectedRangeAsPdf()

'The generated PDF will be saved to the desktop

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "\OneDrive\Desktop\" & Format(Date, "mm-dd-yy") & ".pdf", OpenAfterPublish:=False

End Sub

will this work if the source book isn't on a OneDrive?

 

[orsm6]

Option Explicit Sub SaveSelectedRangeAsPdf() 'The generated PDF will be saved to the desktop Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "\OneDrive\Desktop\" & Format(Date, "mm-dd-yy") & ".pdf", OpenAfterPublish:=False End Sub

sorry - I didn't consider a few things....

a specific range needs to be saved.

sheet name - weekly summary
range - A1:J32

 

[jolivanes]

Re: "also needs to be able to work if the source book is located on a OneDrive if possible."
Does this mean that workbook needs to be opened with code?

 

[orsm6]

Re: "also needs to be able to work if the source book is located on a OneDrive if possible."
Does this mean that workbook needs to be opened with code?

Hi - no what I am saying is that I personally have this file in my OneDrive as it is on my work PC... if another person were to have the file they could have it in their MyDocuments which might not be in their OneDrive

 

[orsm6]

Option Explicit

Sub SaveSelectedRangeAsPdf()

'The generated PDF will be saved to the desktop

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Environ("USERPROFILE") & "\OneDrive\Desktop\" & Format(Date, "mm-dd-yy") & ".pdf", OpenAfterPublish:=False

End Sub

thanks for your help - i managed to find a Ron De Bruin one and butcher it to do as needed.

 

[orsm6]

Re: "also needs to be able to work if the source book is located on a OneDrive if possible."
Does this mean that workbook needs to be opened with code?

thanks for your help - i managed to find a Ron De Bruin one and butcher it to do as needed.

 

[jolivanes]

Since this is a forum where a lot of people come for help, just like you did, and when they end up on this thread they probably think that they would end up with a solution.
Would you be so kind and publish your code here for these people that need help.
Your understanding is very much appreciated.

 

[orsm6]

For anyone that might find this useful, it is a stripped back version of a Ron De Bruin macro. This macro in my workbook is in 2 modules which may or may not be required:

NOTE: you will need to change the range you need to export and the workbook/sheet names

MODULE 1:

Option Explicit
Sub CreateAPDF()

    Dim FileName As String
 
    Dim cell As Range
    Dim StrToo As String
    Dim subject As String
 

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments
        'For a fixed range use this line
        FileName = RDB_Create_PDF(Source:=Range("your_range:goes_here"), _
                                  FixedFilePathName:="", _
                                  OverwriteIfFileExist:=True, _
                                  OpenPDFAfterPublish:=False)
 

    End If
 
End Sub

MODULE 2

Option Explicit
 
Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim fname As Variant
    'Ron de Bruin : 26-April-2020

    If FixedFilePathName = "" Then
        'Open the GetSaveAsFilename dialog to enter a file name for the pdf
        FileFormatstr = "PDF Files (*.pdf), *.pdf"
        fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
            Title:="Create PDF")

        'If you cancel this dialog Exit the function
        If fname = False Then Exit Function
    Else
        fname = FixedFilePathName
    End If

    'If OverwriteIfFileExist = False we test if the PDF
    'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(fname) <> "" Then Exit Function
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    'Now the file name is correct we Publish to PDF
    On Error Resume Next
    Source.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=fname, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    Application.ScreenUpdating = True
    Application.EnableEvents = True

    'If Publish is Ok the function will return the file name
    If Dir(fname) <> "" Then RDB_Create_PDF = fname
End Function


Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    'This function will create a PDF with every sheet with
    'a sheet level name variable <NamedRange> in it
    'Ron de Bruin : 26-April-2020
    Dim FileFormatstr As String
    Dim fname As Variant
    Dim Ash As Worksheet
    Dim sh As Worksheet
    Dim ShArr() As String
    Dim s As Long
    Dim SheetLevelName As Name

    'We fill the Array with sheets with the sheet level name variable
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Visible = -1 Then
            Set SheetLevelName = Nothing
            On Error Resume Next
            Set SheetLevelName = sh.Names(NamedRange)
            On Error GoTo 0
            If Not SheetLevelName Is Nothing Then
                s = s + 1
                ReDim Preserve ShArr(1 To s)
                ShArr(s) = sh.Name
            End If
        End If
        Next sh

    'We exit the function If there are no sheets with
    'a sheet level name variable named <NamedRange>
    If s = 0 Then Exit Function

    If FixedFilePathName = "" Then

        'Open the GetSaveAsFilename dialog to enter a file name for the pdf
        FileFormatstr = "PDF Files (*.pdf), *.pdf"
        fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
            Title:="Create PDF")

        'If you cancel this dialog Exit the function
        If fname = False Then Exit Function
    Else
        fname = FixedFilePathName
    End If

    'If OverwriteIfFileExist = False we test if the PDF
    'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(fname) <> "" Then Exit Function
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

End Function