Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88854

Create PDF with specific ranges in one sheet with using Excel macro

$
0
0

I can create pdf in a range but number of pages cannot be standardized. so is there any possiblity to update my macro to create 4 page pdf within my known range.

Dim fso As Object
Dim s(1) As String
Dim sNewFilePath As String
Dim pg1 As Range
Dim pg2 As Range
Dim pg3 As Range
Dim pg4 As Range
Dim r As Range
Dim ws As Worksheet
    Set ws = ActiveSheet
     With ws.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .FitToPagesWide = 1
    End With
Set pg1 = ActiveSheet.Range("A1:K92")
Set pg2 = ActiveSheet.Range("A93:K164")
Set pg3 = ActiveSheet.Range("A165:K237")
Set pg4 = ActiveSheet.Range("A239:K313")
Set r = Union(pg1, pg2, pg3, pg4)
    Set fso = CreateObject("Scripting.FileSystemObject")
    s(0) = ThisWorkbook.FullName

    If fso.FileExists(s(0)) Then
        '//Change Excel Extension to PDF extension in FilePath
        s(1) = fso.GetExtensionName(s(0))
        If s(1) <> "" Then
            s(1) = "."& s(1)
            sNewFilePath = Replace(s(0), s(1), ".pdf")


                r.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNewFilePath, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
        End If
    Else
        '//Error: file path not found
        MsgBox "Error: this workbook may be unsaved.  Please save and try again."
    End If

    Set fso = Nothing
ActiveWorkbook.Save
ActiveWindow.Close

this is not working as i imagine. i have also tried hpagebreaks.addand i cannot manage it.

so do you have any idea?


Viewing all articles
Browse latest Browse all 88854


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>