如何在 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

截图：