Resizing print output of userform

[IMM Tech]

Hello again.


I am using a piece of code (at the bottom of the post) I found plastered all over google to print my userform on a single page. It essentially takes a screenshot, dumps it into a new workbook, sets the print area and properties, then prints to the default printer.

This works... mostly ok. I am however having an issue where occasionally a random frame will be missing the title and one of the text boxes will print blank. This does not happen on all prints and does not always happen with the same objects.

It also isn't fully filling the page despite the margins being set to a small value, nor is it centering left to right despite being set to do so with centerhorizontally set to true.


I did find this, which works rather nicely by opening printer selection, and I would prefer to use this or something similar, except it prints in portrait across multiple pages due to the resolution of the userform and despite being set to landscape manually each time.

Dim RetStat
RetStat = Application.Dialogs(xlDialogPrinterSetup).Show
If RetStat Then Me.PrintForm

Is there a way to automatically set the print properties using this sort of method to fit to one landscape page using something similar or that can be added to this that doesn't open a new excel workbook? I need this to be as simplified as possible for the users.





And last but not least, this is what I found and am currently using. Perhaps there is an error with this method that causes the blank objects? It also occasionally fails to set the background colors correctly. I have a section that changes the backgrounds all to white, then changes them back to clarity on a computer monitor without printing a grey background. Once in a while some of the frames don't properly change.

    

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





Dim strPrintArea
DoEvents
    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:02")
    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.Shapes(1).Select    'Will always be Shape 1
   
         With Selection  'Get print area of picture
         strPrintArea = .TopLeftCell.Address & ":" & .BottomRightCell.Address
     End With
 
     ActiveSheet.PageSetup.PrintArea = ""
   
     With ActiveSheet.PageSetup
         .PrintArea = strPrintArea  'Set Print Area
         .LeftHeader = ""
         .CenterHeader = ""
         .RightHeader = ""
         .LeftFooter = ""
         .CenterFooter = ""
         .RightFooter = ""
         .LeftMargin = Application.InchesToPoints(0#)
         .RightMargin = Application.InchesToPoints(0#)
         .TopMargin = Application.InchesToPoints(0#)
         .BottomMargin = Application.InchesToPoints(0#)
         .HeaderMargin = Application.InchesToPoints(0#)
         .FooterMargin = Application.InchesToPoints(0#)
         .PrintHeadings = False
         .PrintGridlines = False
         .PrintComments = xlPrintNoComments
         .CenterHorizontally = True
         .CenterVertically = True
         .Orientation = xlLandscape
         .Draft = False
         .PaperSize = xlPaperLetter
         .FirstPageNumber = xlAutomatic
         .Order = xlDownThenOver
         .BlackAndWhite = True
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 1
     End With
     ActiveWindow.SelectedSheets.PrintOut Copies:=1
     ActiveWorkbook.Close False

[IMM Tech]

I have a photo of back to back prints showing examples of the defects that occur with the screenshot/paste/print sheet method. No settings nor anything on the form were changed between these prints.


You can just barely see the grey background still present on the left one, and the missing text. This would cause some problems on the floor and I don't want to rely on this method.

20180218_183457.jpg