怎怎样使vb的datrpt自定义成横向、A4纸张，高分300分

Question

在程序中选择纸张类型或设置纸张大小
DataReport做报表的局限性太大,这里提供一个函数
将以下代码放在模块中Option Explicit
Public Enum PrinterOrientationConstants
  OrientPortrait = 1
  OrientLandscape = 2
End Enum'Printer.PaperSize = vbPRPSA3
Private Type DEVMODE
  dmDeviceName As String * 32
  dmSpecVersion As Integer
  dmDriverVersion As Integer
  dmSize As Integer
  dmDriverExtra As Integer
  dmFields As Long
  dmOrientation As Integer
  dmPaperSize As Integer
  dmPaperLength As Integer
  dmPaperWidth As Integer
  dmScale As Integer
  dmCopies As Integer
  dmDefaultSource As Integer
  dmPrintQuality As Integer
  dmColor As Integer
  dmDuplex As Integer
  dmYResolution As Integer
  dmTTOption As Integer
  dmCollate As Integer
  dmFormName As String * 32
  dmUnusedPadding As Integer
  dmBitsPerPel As Integer
  dmPelsWidth As Long
  dmPelsHeight As Long
  dmDisplayFlags As Long
  dmDisplayFrequency As Long
End TypePrivate Type PRINTER_DEFAULTS
  pDataType As String
  pDevMode As Long
  DesiredAccess As Long
End TypePrivate Type PRINTER_INFO_2
  pServerName As Long
  pPrinterName As Long
  pShareName As Long
  pPortName As Long
  pDriverName As Long
  pComment As Long
  pLocation As Long
  pDevMode As Long
  pSepFile As Long
  pPrintProcessor As Long
  pDataType As Long
  pParameters As Long
  pSecurityDescriptor As Long
  Attributes As Long
  Priority As Long
  DefaultPriority As Long
  StartTime As Long
  UntilTime As Long
  Status As Long
  cJobs As Long
  AveragePPM As Long
End TypePrivate Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_PAPERSIZE = 3Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2
Private Const DM_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2&Private Const DMPAPER_A3 = 8                    '  A3 297 x 420 mm
Private Const DMPAPER_A4 = 9                    '  A4 210 x 297 mmPrivate Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
    PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource _
  As Any, ByVal cbCopy As Long)Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal _
  pPrinterName As String, phPrinter As Long, pDefault As Any) As LongPrivate Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As LongPrivate Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (_
  ByVal hWnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, pDevModeOutput As _
  Any, pDevModeInput As Any, ByVal fMode As Long) As LongPrivate Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As _
  Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As LongPrivate Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As _
  Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As LongPrivate Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (_
  ByVal lpDeviceName As String, ByVal lpPort As String, ByVal iIndex As Long, ByVal lpOutput _
  As String, lpDevMode As DEVMODE) As LongFunction SetDefaultPrinterOrientation(ByVal eOrientation As PrinterOrientationConstants, ByVal _
  strPaperSize As String) As Boolean
  Dim bDevMode() As Byte
  Dim bPrinterInfo2() As Byte
  Dim hPrinter As Long
  Dim lResult As Long
  Dim nSize As Long
  Dim sPrnName As String
  Dim dm As DEVMODE
  Dim pd As PRINTER_DEFAULTS
  Dim pi2 As PRINTER_INFO_2
  ' Get device name of default printer
  sPrnName = Printer.DeviceName
  ' PRINTER_ALL_ACCESS required under
  ' NT, because we're going to call
  ' SetPrinter
  pd.DesiredAccess = PRINTER_ALL_ACCESS
  ' Get a handle to the printer.
  If OpenPrinter(sPrnName, hPrinter, pd) Then
    ' Get number of bytes requires for
    ' PRINTER_INFO_2 structure
    Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize)
    ' Create a buffer of the required size
    ReDim bPrinterInfo2(1 To nSize) As Byte
    ' Fill buffer with structure
    lResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), nSize, nSize)
    ' Copy fixed portion of structure
    ' into VB Type variable
    Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2))
    ' Get number of bytes requires for
    ' DEVMODE structure
    nSize = DocumentProperties(0&, hPrinter, sPrnName, 0&, 0&, 0)
    ' Create a buffer of the required size
    ReDim bDevMode(1 To nSize)
    ' If PRINTER_INFO_2 points to a DEVMODE
    ' structure, copy it into our buffer
    If pi2.pDevMode Then
      Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))
     Else
      ' Otherwise, call DocumentProperties
      ' to get a DEVMODE structure
      Call DocumentProperties(0&, hPrinter, sPrnName, bDevMode(1), 0&, DM_OUT_BUFFER)
    End If    ' Copy fixed portion of structure
    ' into VB Type variable
    Call CopyMemory(dm, bDevMode(1), Len(dm))
    With dm
      ' Set new orientation
      Select Case strPaperSize
        Case "A3"
          .dmPaperSize = DMPAPER_A3
        Case "A4"
          .dmPaperSize = DMPAPER_A4
      End Select
      .dmOrientation = eOrientation
      .dmFields = DM_ORIENTATION + DM_PAPERSIZE
    End With
    ' Copy our Type back into buffer
    Call CopyMemory(bDevMode(1), dm, Len(dm))
    ' Set new orientation
    Call DocumentProperties(0&, hPrinter, sPrnName, bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _
      DM_OUT_BUFFER)
    ' Point PRINTER_INFO_2 at our
    ' modified DEVMODE
    pi2.pDevMode = VarPtr(bDevMode(1))
    ' Set new orientation system-wide
    lResult = SetPrinter(hPrinter, 2, pi2, 0&)
    ' Clean up and exit
    Call ClosePrinter(hPrinter)
    SetDefaultPrinterOrientation = True
   Else
    SetDefaultPrinterOrientation = False
  End If
End Function
调用:
SetDefaultPrinterOrientation 2, "A4" '其中第一个参数表示横式或者纵式