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 find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

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,472
Messages
5,548,228
Members
410,824
Latest member
Bobmn4
Top