Как распечатать полную форму пользователя в VBA

Question

У меня есть пользовательская форма в VBA, с высотой 515 и шириной 975. И этот код я использую для ее печати. ​​

Private Sub CommandButton4_Click()
    Questionaire1.PrintForm
End Sub

Этот код отлично работает, когда я нажимаю кнопку ПечатьФорма дает мне возможность сохранить форму в формате PDF, но этот код печатает только меньшее зелье формы, тогда как я хочу напечатать всю форму.

Answer 1

Попробуйте этот код: сначала объявите этот код:

Option Explicit
Private Declare PtrSafe Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, ByVal bScan As Byte, _
     ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

РЕДАКТИРОВАТЬ: Или, если возникла ошибка, объявите это (система x32):

Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Const VK_SNAPSHOT = 44
Public Const VK_LMENU = 164
Public Const KEYEVENTF_KEYUP = 2
Public Const KEYEVENTF_EXTENDEDKEY = 1

И вставьте это в свой код кнопки:

Private Sub CommandButton4_Click()
    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: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
        .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
End Sub

Это работа для меня.Источник: https://www.excelbanter.com/excel-programming/418448-print-userform-fit-one-page.html

Снимок экрана: