Macro for automatic print layout

[niccoflo]

Hello,

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

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

 

[niccoflo]

Hello, anyone has a clue to resolve this? I am really struggling. Thanks a lot

 

[jamiemarie]

You need to add this line for the dialog box to show.

bTemp = Application.Dialogs(xlDialogPrint).Show

Displaying the Print Dialog Box in a Macro

Want to print a document by using a macro? One way is to display the Print dialog box and allow the user to interact with it. This tip demonstrates how easy it is to actually pull up the desired dialog box.

excelribbon.tips.net

 

[niccoflo]

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