How to Print UserForm Orientation Landscape

How to Print UserForm in Orientation Landscape

Requirement:

The user would like to have a command button on a userform that, when clicked, simply prints the complete userform, including the border, as an image but centred horizontally and vertically on a piece of A4 paper in landscape orientation. The user has found lots of threads asking a similar question but has not found an answer to work.

Solution:

Code:

Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
 
 
Private Sub CommandButton1_Click()
 
   DoEvents
 
   Application.ScreenUpdating = False
 
   keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
   keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
   keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
   keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
 
   DoEvents
 
   Workbooks.Add
 
   Application.Wait Now + TimeValue("00:00:01")
   ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
   DisplayAsIcon:=False
   ActiveSheet.Range("A1").Select
   'added to force landscape
   ActiveSheet.PageSetup.Orientation = xlLandscape
 
   With ActiveSheet.PageSetup
      .PrintTitleRows = ""
      .PrintTitleColumns = ""
   End With
 
   ActiveSheet.PageSetup.PrintArea = ""
 
   With ActiveSheet.PageSetup
      .LeftHeader = ""
      .CenterHeader = ""
      .RightHeader = ""
      .LeftFooter = ""
      .CenterFooter = ""
      .RightFooter = ""
      .LeftMargin = Application.InchesToPoints(0.75)
      .RightMargin = Application.InchesToPoints(0.75)
      .TopMargin = Application.InchesToPoints(1)
      .BottomMargin = Application.InchesToPoints(1)
      .HeaderMargin = Application.InchesToPoints(0.5)
      .FooterMargin = Application.InchesToPoints(0.5)
      .PrintHeadings = False
      .PrintGridlines = False
      .PrintComments = xlPrintNoComments
 
      '// One or more properties may not be available
      ' .PrintQuality = 300
 
      .CenterHorizontally = True
      .CenterVertically = True
      .Orientation = xlLandscape
      .Draft = False
      .PaperSize = xlPaperA4
      .FirstPageNumber = xlAutomatic
      .Order = xlDownThenOver
      .BlackAndWhite = False
      .Zoom = False
      .FitToPagesWide = 1
      .FitToPagesTall = 1
   End With
 
   ActiveWindow.SelectedSheets.PrintOut Copies:=1
   ActiveWorkbook.Close False
 
   Application.ScreenUpdating = True
 
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by cytop.