Save excel as PDF

[me_gem69]

i want to save excel as PDF & am able to do that but when it publishes into PDF it does not take document properties like pagesize, margins etc...

following is the code that i am using

Private Sub CommandButton1_Click()
Dim Parts_Per_Block As Long
Dim Copy_Parts_Row_start As Long
Dim Copy_Parts_Row_End As Long
Dim Page_Number As Long
Dim Nf_All_Parts As Long
Dim Number_Of_sheets As Long
Dim Number_Of_Pages_Required As Long
Dim Temp_Range As String
Dim Div As Double
Dim Page_Number_Column As Long
Dim Page_Number_Row As Long
Dim Template_Block_Start_Row As Long
Dim Dummy As Integer
Dim HeaderRng, TempRng, FooterRng As Range
Dim TemplEnd As Long
Dim All_Parts_End_Row As Long
Dim Header_Start As Long
Dim Temp_Start As Long
Dim Footer_Start As Long
Dim print_area
Dim var1 As String
Dim Page_End_Alp As String
Dim Page_End_Num As String
Dim Template_Start As Long
Dim tempr As Range
Dim tem As Long
Dim Page_Start_Alp As String
Dim Page_Start_Num As String
Dim Temp_Header As String
Dim PN As Long
Dim PN2 As Long
Dim PN3 As Long
Dim Rng As Range
Dim Rng2 As Range


'Find the print area set by user

print_area = Sheets("Template").PageSetup.PrintArea

MsgBox print_area

var1 = Right(print_area, 5)

'Get the last column in the print area
Page_End_Alp = Mid(var1, 2, 1)

'Get the last row in the print area
Page_End_Num = Mid(var1, 4, 2)

'Get the first column in the print area
Page_Start_Alp = Mid(print_area, 2, 1)

'Get the first row in the print area
Page_Start_Num = Mid(print_area, 4, 1)



Header_Start = 1

Temp_Header = Page_Start_Num
ActiveSheet.Cells(1, 1).Select

ActiveSheet.Cells.Find(What:="Part Number", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate


Template_Block_Start_Row = ActiveCell.Row
Template_Start = Template_Block_Start_Row


'No. of rows in the header
tem = Template_Start - Temp_Header


Temp_Start = Header_Start + tem

Sheets("Template").Select

ActiveSheet.Cells(1, 1).Select


'---- Find size of each Block on Page -----

Sheets("Template").Select
ActiveSheet.Range("B" + Trim(str(Template_Block_Start_Row))).Select
Selection.End(xlDown).Select
TemplEnd = ActiveCell.Row
Dummy = ActiveCell.Row - Template_Block_Start_Row
Parts_Per_Block = Dummy

'---- Find the Cell to Type in Page Number ------
'-------Taking "Page Number" in Range Variable from Template sheet ------
'------- For handling the issue if there is No "page Number" in Template sheet

Sheets("Template").Select
Set Rng = ActiveSheet.Cells.Find(What:="Page Number", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)

'If Not Rng Is Nothing Then
' Else
' End If

PN = Page_End_Num
MsgBox PN
PN2 = Template_Start + Parts_Per_Block
PN3 = PN - PN2
Footer_Start = Temp_Start + Parts_Per_Block + PN3

'---- Find Total Number of Parts -----

Sheets("All Parts").Select
ActiveSheet.Range("A1").Select
Selection.End(xlDown).Select
All_Parts_End_Row = ActiveCell.Row
Nf_All_Parts = ActiveCell.Row - 1

'---- Calculate the Number of Pages Required ----

Div = Nf_All_Parts / (2 * Parts_Per_Block)
Number_Of_Pages_Required = Nf_All_Parts / (2 * Parts_Per_Block)

If (Div > Number_Of_Pages_Required) Then
Number_Of_Pages_Required = Number_Of_Pages_Required + 1
End If

ThisWorkbook.Sheets.Add After:=Sheets(Worksheets.count)

'---- Now start generating each page ad copying -----

Copy_Parts_Row_start = 2
Page_Number = 1


Load UserForm1
UserForm1.Show vbModeless
UserForm1.Caption = "Generating PDF Section...Please Wait..."
UserForm1.LoadBar.Width = 2
UserForm1.Repaint

Application.ScreenUpdating = False

Do While Page_Number <= Number_Of_Pages_Required
'--------- First Make a Copy of Template --------

'Sheets("Template").Select
Number_Of_sheets = ActiveWorkbook.Sheets.count

'--- Now, Copy Block from All Parts to paste to 1st block in page---

Copy_Parts_Row_End = Copy_Parts_Row_start + Parts_Per_Block - 1

'copy the header from template sheet
Sheets("Template_CFM").Range("A" + Trim(str(Page_Start_Num)) + ":L" + Trim(str(Template_Start - 1))).Copy

'paste the header in the new sheet
ActiveSheet.Range("A" + Trim(str(Header_Start))).Select
ActiveSheet.paste

'copy the column width for the 1st block from template sheet and paste it into new sheet
Sheets("Template_CFM").Range("B" + Trim(str(Template_Start)) + ":F" + Trim(str(TemplEnd))).Copy

ActiveSheet.Range("B" + Trim(str(Temp_Start))).Select
Selection.PasteSpecial paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

'copy column header of the 1st block from template sheet and paste it into the new sheet
Sheets("Template_CFM").Range("B" + Trim(str(Template_Start)) + ":F" + Trim(str(Template_Start))).Copy

ActiveSheet.Range("B" + Trim(str(Temp_Start))).Select
ActiveSheet.paste


'copy data from the All Parts sheet and paste it into the first block in the new sheet

Temp_Range = "A" + Trim(str(Copy_Parts_Row_start)) + ":F" + Trim(str(Copy_Parts_Row_End))
Sheets("All Parts").Range(Temp_Range).Copy


Copy_Parts_Row_start = Copy_Parts_Row_End + 1

'-------- Paste Block in First Block of Page -----

ActiveSheet.Range("B" + Trim(str(Temp_Start + 1))).Select
ActiveSheet.paste



'--- Now, Copy Block from All Parts to paste to 2nd block in page---

Copy_Parts_Row_End = Copy_Parts_Row_start + Parts_Per_Block - 1




'copy column width of the second block from template sheet and paste it into the new sheet
Sheets("Template_CFM").Range("H" + Trim(str(Template_Start)) + ":L" + Trim(str(TemplEnd))).Copy
'Selection.Copy


'Sheets("Page").Select
ActiveSheet.Range("H" + Trim(str(Temp_Start))).Select
Selection.PasteSpecial paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False



'copy column header of the second block from template sheet and paste it into the new sheet

Sheets("Template_CFM").Range("H" + Trim(str(Template_Start)) + ":L" + Trim(str(Template_Start))).Copy
'Selection.Copy

'Sheets("Page").Select
ActiveSheet.Range("H" + Trim(str(Temp_Start))).Select
ActiveSheet.paste


'copy data from All Parts sheet and paste it into the second block in the new sheet

Temp_Range = "A" + Trim(str(Copy_Parts_Row_start)) + ":F" + Trim(str(Copy_Parts_Row_End))
Sheets("All Parts").Range(Temp_Range).Copy
'Selection.Copy

'-------- Paste Block in First Block of Page -----

ActiveSheet.Range("H" + Trim(str(Temp_Start + 1))).Select
ActiveSheet.paste

Copy_Parts_Row_start = Copy_Parts_Row_End + 1



'copy footer from the template sheet and paste it into the new sheet
Sheets("Template_CFM").Range("A" + Trim(str(PN2 + 1)) + ":L" + Trim(str(Page_End_Num))).Copy
'Selection.Copy

'Sheets("Page").Select
ActiveSheet.Range("A" + Trim(str(Temp_Start + Parts_Per_Block + 1))).Select

ActiveSheet.paste


'copy format of the template sheet and paste it into the new sheet
Sheets("Template_CFM").Range("A" + Trim(str(Page_Start_Num)) + ":L" + Trim(str(Page_End_Num))).Copy

ActiveSheet.Range("A" + Trim(str(Header_Start))).Select
Selection.PasteSpecial paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

' Initilizing Page Number in Both the cases on Active Sheet
' 1) User types "Page Number" in Template sheet
' 2) User does not mention "Page Number" in Template sheet

Set Rng2 = ActiveSheet.Cells.Find(What:="Page Number", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng2 Is Nothing Then
Rng2 = Page_Number

Else
ActiveSheet.Range("L" + Trim(str(Footer_Start))).Select
Selection.value = Page_Number

End If


Temp_Range = "L" + Trim(str(Footer_Start + 1))
Set tempr = Range(Temp_Range)

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=tempr


Temp_Range = "M" + Trim(str(Footer_Start + 1))
Set tempr = Range(Temp_Range)
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=tempr


'new values for next iteration
Header_Start = Footer_Start + 2
Temp_Start = Header_Start + tem
Template_Block_Start_Row = Temp_Start
Footer_Start = Template_Block_Start_Row + Parts_Per_Block + PN3

Page_Number = Page_Number + 1


UserForm1.LoadBar.Width = (Page_Number + 1) * (400 / Div)
UserForm1.Repaint



Loop



UserForm1.Hide


'fit to one page
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
'.FitToPagesTall = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With

Application.ScreenUpdating = True

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\newcat12.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True


ActiveSheet.Cells(1, 1).Select



End Sub


Here i am adding the data into a table. There are two tables on one page.
i also wanted a help to end the table when the data ends
but for now even after data ends half way i get blanks rows after that.
also a blank table if data ends on one half of the page.

 

[DragonWood]

You can try putting this in where you tell it how to save the file.

 'Save the Sheet1 page as a PDF
    Application.Goto Sheets("Sheet1").Range("A1"), True
    With Sheets("Sheet1")
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Sheet1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    End With