Set PageBreak and PrintArea

[semperidem46]

Hello,

I wrote a code to set dynamically Print Area, based on a cell value.
After that I want to set Page Brake.
In the and, I want to export the sheet in PDF.
In this code, PageBreake is not working.

This excel file will be used by many people, on many computers. I am trying to find a way to have same PDF print layout for everyoane.
Thankes in advance for your help.

here is my code:

S
Sub PDFActiveSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandlerSet wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")

'get PrintArea
If Len(Range("O9").Value) = 13 Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$AM$168"
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 3
End With
ActiveSheet.ResetAllPageBreaks
Set ActiveSheet.HPageBreaks(1).Location = Range("A57")
Set ActiveSheet.HPageBreaks(2).Location = Range("A113")
Else
ActiveSheet.PageSetup.PrintArea = "$A$1:$AM$112"
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
ActiveSheet.ResetAllPageBreaks
Set ActiveSheet.HPageBreaks(1).Location = Range("A57")
End If

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & ""
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = Range("O8").Value & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

 

[lhartono]

Re: Set PageBreake and PrintArea

Try this,

[COLOR=#d3d3d3]'[/COLOR]
[COLOR=#0000cd]Sub PDFActiveSheet2()
Dim wsA         As Worksheet
Dim wbA         As Workbook
Dim strTime     As String
Dim strName     As String
Dim strPath     As String
Dim strFile     As String
Dim strPathFile As String
Dim myFile      As Variant
Dim n           As Long
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")

Application.ScreenUpdating = False
    
    ActiveWindow.View = xlPageBreakPreview
    
    With wsA.PageSetup
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
    End With
    
    wsA.ResetAllPageBreaks
    
    For n = wsA.HPageBreaks.Count To 1 Step -1
        wsA.HPageBreaks(n).DragOff xlDown, 1
    Next

    For n = wsA.VPageBreaks.Count To 1 Step -1
        wsA.VPageBreaks(n).DragOff xlToRight, 1
    Next
    
[/COLOR][COLOR=#a9a9a9]    'get PrintArea[/COLOR][COLOR=#0000cd]
    If Len(Range("O9").Value) = 13 Then
        wsA.PageSetup.PrintArea = "$A$1:$AM$168"
        wsA.HPageBreaks.Add Before:=Rows("57:57")
        wsA.HPageBreaks.Add Before:=Rows("113:113")
    Else
        wsA.PageSetup.PrintArea = "$A$1:$AM$112"
        wsA.HPageBreaks.Add Before:=Rows("57:57")
    End If
    
Application.ScreenUpdating = True
[/COLOR][COLOR=#a9a9a9]'get active workbook folder, if saved[/COLOR][COLOR=#0000cd]
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & ""
[/COLOR][COLOR=#a9a9a9]'replace spaces and periods in sheet name[/COLOR][COLOR=#0000cd]
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
[/COLOR][COLOR=#a9a9a9]'create default name for savng file[/COLOR][COLOR=#0000cd]
strFile = Range("O8").Value & "_" & strTime & ".pdf"
strPathFile = strPath & "\" & strFile
[/COLOR][COLOR=#a9a9a9]'use can enter name and select folder for file[/COLOR][COLOR=#0000cd]
myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")
[/COLOR][COLOR=#a9a9a9]'export to PDF if a folder was selected[/COLOR][COLOR=#0000cd]
If myFile <> "False" Then
    wsA.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True
End If

exitHandler:
    wsA.ResetAllPageBreaks
    ActiveWindow.View = xlNormalView
    Application.ScreenUpdating = True
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

[/COLOR]

 

[semperidem46]

Re: Set PageBreake and PrintArea

Thank you for your effort.
Now pagebrake it's ok, but in the PDF the content it's shown in the first dial of the page and rest of the page have a huge blank space.
Is there a solution for that?