Macro for automatic print layout

niccoflo

New Member
Joined
Jun 11, 2016
Messages
13
Hello,

I have the following macro to get automatically a Print Layout.

VBA Code:
Sub PrintLayouts()
'
' OK_Layout Macro
'
   
Dim logo As String
logo = Application.GetOpenFilename _
(Title:="Please choose a client logo")
    ActiveSheet.PageSetup.LeftHeaderPicture.Filename = logo
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 31.8
.Width = 40.8
End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&G"
.CenterHeader = "&16Confidential"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P"
.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
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.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.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&G"
.CenterHeader = "&16Confidential"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P"
.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
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.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.PrintCommunication = True


With ActiveSheet.PageSetup
.CenterHeader = "&""Arial""Confidential"
.LeftFooter = "&F"
.CenterFooter = "&A"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.47244094488189)
.TopMargin = Application.InchesToPoints(0.94488188976378)
.BottomMargin = Application.InchesToPoints(0.94488188976378)
.HeaderMargin = Application.InchesToPoints(0.47244094488189)
.FooterMargin = Application.InchesToPoints(0.47244094488189)
End With
'End If

End Sub


The macro works perfectly. Then I assigned this macro to a shortcut

Application.OnKey "^%{l}", "PrintLayouts"

Also the short-cut works perfectly. HOWEVER

If I try to press "Ctrl+P" (Excel shortcut) to get the Print Preview, instead of opening the print preview, it runs again the macro above! In other words, if I go to Developer --> Macro, I am not sure why Excel assigns the Ctrl+P shortcut to the macro above! Why? This is driving me crazy

Thanks a lot
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

niccoflo

New Member
Joined
Jun 11, 2016
Messages
13
Hello, anyone has a clue to resolve this? I am really struggling. Thanks a lot
 

jamiemarie

Board Regular
Joined
Jun 24, 2020
Messages
67
Office Version
  1. 365
Platform
  1. Windows
You need to add this line for the dialog box to show.
VBA Code:
bTemp = Application.Dialogs(xlDialogPrint).Show

 

niccoflo

New Member
Joined
Jun 11, 2016
Messages
13
Sorry Jamiemarie I don't think you understood the problem. Please could you either explain your answer or re-read the problem? Thanks a lot
 

Watch MrExcel Video

Forum statistics

Threads
1,114,645
Messages
5,549,166
Members
410,902
Latest member
G Slim
Top