怎样才能改变打印机的打印方向？

[masterkey]

我在用DataReport 做报表时发现一问题，向各位请教：
比如有两个不同的报表，一个是横向打印的，而另一个是纵向打印的，怎样才能实现不通过用户对话框方式就可以改变打印机的打印方向呢？ 也就是用程序语句，用户完全不设置打印机属性就可以自由地打印这两个报表！

[masterkey]

老兄你的办法也不行啊，通过测试不能改变系统默认打印机的打印方向，而且我的要求是不能出现对话框（如果可以出现对话框的话那就简单多了，直接调用VB的Commondialog控件就好了），要直接控制，不让用户参与。 我用DocumentProperties等API也不行， 该怎么办呢，各位帮我想想办法吧！！！！

[playyuer]

方 法 1: 装VB6SP4,DataReport新添了Orientation属性
http://www4.netease.com/~askpro/msg21/qa85.htm
方 法 2:
用 一 个 CommonDialog:

Private Sub Command1_Click()
CommonDialog1.Flags = cdlPDPrintSetup
CommonDialog1.CancelError = True
On Error GoTo ErrorHandle:
CommonDialog1.ShowPrinter '必 须 Show出 来 且 "确 定 "才 能 修 改 纸 方 向
'Me.Refresh
'Command1.Refresh
On Error GoTo 0
DataReport1.Show vbModal
ErrorHandle:
End Sub
下 载 例 程 rptdemo.zip。
方 法 3: 引 用 PageSet.Dll(参 考 :微 软 的 Knowledge Base的 文 章：“Q198901 Sample PageSet_exe Programmatically Changes Default Printer Orientation” 并 下 载 PageSet.exe,或 orientation.zip。
但 有 时 报 出 "报 表 宽 度 大 于 纸 的 宽 度 "的 错 误 。 (参 考 :微 软 的 Knowledge Base的 文 章：“Q197915 PRB Report Width is Larger than the Paper Width” (我 认 为 没 什 么 用 ,不 知 所 云 ))
该 方 法 并 未 真 正 将 Printer改 方 向 (即 :Printer.Width与 Printer.Height并 未 交 换 ),因 此 我 建 议 :
Private Sub DataReport_Initialize()
Const ErrX = 0 '误 差 经 验 值
Dim adoRecordset As New ADODB.Recordset
adoRecordset.Fields.Append "Fld1", adVariant, , adFldIsNullable + adFldMayBeNull
adoRecordset.Open
Set Me.DataSource = adoRecordset
'下 一 句 非 常 关 键 重 要 ,可 以 极 大 地 减 少 "报 表 宽 度 大 于 纸 的 宽 度 "的 错 误 !
'当 Form1.Option1.Value为 真 时 "横 打 ",否 则 "纵 打 "
Me.ReportWidth = IIf(Form1.Option1.Value, MyMax(Printer.Width, Printer.Height),
MyMin(Printer.Width, Printer.Height)) - Me.LeftMargin - Me.RightMargin-ErrX
End Sub
Private Function MyMax(a As Long, b As Long) As Long
MyMax = IIf(a > b, a, b)
End Function
Private Function MyMin(a As Long, b As Long) As Long
MyMin = IIf(a < b, a, b)
End Function
这 样 就 可 以 极 大 地 减 少 "报 表 宽 度 大 于 纸 的 宽 度 "的 错 误 !
注 :"横 打 "即 :打 印 以 纸 的 宽 边 作 顶 部 。 "纵 打 "即 :打 印 以 纸 的 窄 边 作 顶 部 。

[masterkey]

谁可以帮我一下呢？

[Un1]

给你一个PrintDlg源码：

'clsPrintDialog.cls文件


Option Explicit
' =======================================================================
'
' CLASS : clsPrintDialog
' PURPOSE : Show a dialog to select a printer and to set printer
' properties. Selected printer will be set to Printer object
' WITHOUT CHANGING DEFAULT PRINTER.
' Printer object could print to selected printer then.
' This class work like "MS Common Dialogs" ShowPrinter method,
' but it set Printer object without changing default printer.
' HELP : Look "MS Common Dialogs" OCX help, it applies also to this
' class. All Flags constants are supported.
' NOTE : Do you have found any bug or improvement ?
' Please let me know, that's why I'm sharing source code.
' AUTHOR : ___________________________________________________
' Luca Minudel software designer
' Italy Conegliano(TV)
' voice & fax [phone]
' e-mail [e-mail]
' WWW (italian language used)
' http://www.geocities.com/SiliconValley/Vista/4041
'
' =======================================================================
'
' --- API CONSTANTS
'
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const DM_DUPLEX = &H1000&
Private Const DM_ORIENTATION = &H1&
'
' --- API TYPES DEFINITION
'
Private Type PRINTDLG_TYPE
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hdc As Long
Flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type
Private Type DEVNAMES_TYPE
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
extra As String * 100
End Type
Private Type DEVMODE_TYPE
dmDeviceName As String * CCHDEVICENAME
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 * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
'
' --- API DECLARATIONS
'
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" _
(pPrintdlg As PRINTDLG_TYPE) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" _
(ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
'
' --- PUBLIC ENUM
'
Public Enum PrinterConstants
cdlPDAllPages = &H0
cdlPDCollate = &H10
cdlPDDisablePrintToFile = &H80000
cdlPDHelpButton = &H800
cdlPDHidePrintToFile = &H100000
cdlPDNoPageNums = &H8
cdlPDNoSelection = &H4
cdlPDNoWarning = &H80
cdlPDPageNums = &H2
cdlPDPrintSetup = &H40
cdlPDPrintToFile = &H20
cdlPDReturnDC = &H100
cdlPDReturnDefault = &H400
cdlPDReturnIC = &H200
cdlPDSelection = &H1
cdlPDUseDevModeCopies = &H40000
End Enum
Public Enum ErrorConstants
cdlCancel = 32755
End Enum
'
' --- PRIVATE VARIABLES
'
Private intMinPage As Integer ' Local copy of Min
Private intMaxPage As Integer ' Local copy of Max
Private intFromPage As Integer ' Local copy of FromPage
Private intToPage As Integer ' Local copy of ToPage
' N.B. 0 >= Min >= FromPage >= ToPage >= Max
' If Max=0 then no limits.
'
' --- PUBLIC VARIABLES
'
Public Flags As PrinterConstants
Public CancelError As Boolean
'
' -- INITIALIZE
'
Private Sub Class_Initialize()
intMinPage = 0
intMaxPage = 0
intFromPage = 0
intToPage = 0
CancelError = False
End Sub
'
' -- PUBLIC MEMBERS
'
Property Get Min() As Integer
Min = intMinPage
End Property
Property Let Min(ByVal intNewValue As Integer)
intNewValue = IIf(intNewValue > 0, intNewValue, 0)
intMinPage = intNewValue
If intNewValue > intFromPage Then _
intFromPage = intNewValue
If intNewValue > intToPage Then _
intToPage = intNewValue
If intNewValue > intMaxPage Then _
intMaxPage = intNewValue
End Property
Property Get FromPage() As Integer
FromPage = intFromPage
End Property
Property Let FromPage(ByVal intNewValue As Integer)
intNewValue = IIf(intNewValue > 0, intNewValue, 0)
intFromPage = intNewValue
If intNewValue > intToPage Then _
intToPage = intNewValue
If intNewValue > intMaxPage Then _
intMaxPage = intNewValue
If intNewValue < intMinPage Then _
intMinPage = intNewValue
End Property
Property Get ToPage() As Integer
ToPage = intToPage
End Property
Property Let ToPage(ByVal intNewValue As Integer)
intNewValue = IIf(intNewValue > 0, intNewValue, 0)
intToPage = intNewValue
If intNewValue > intMaxPage Then _
intMaxPage = intNewValue
If intNewValue < intFromPage Then _
intFromPage = intNewValue
If intNewValue < intMinPage Then _
intMinPage = intNewValue
End Property
Property Get Max() As Integer
Max = intMaxPage
End Property
Property Let Max(ByVal intNewValue As Integer)
intNewValue = IIf(intNewValue > 0, intNewValue, 0)
intMaxPage = intNewValue
If intNewValue < intToPage Then _
intToPage = intNewValue
If intNewValue < intFromPage Then _
intFromPage = intNewValue
If intNewValue < intMinPage Then _
intMinPage = intNewValue
End Property
Public Function ShowPrinter() As Boolean
Dim PrintDlg As PRINTDLG_TYPE
Dim DevMode As DEVMODE_TYPE
Dim DevName As DEVNAMES_TYPE
Dim lpDevMode As Long, lpDevName As Long
Dim intReturn As Integer
Dim objPrinter As Printer
Dim strNewPrinterName As String
Dim blnCancel As Boolean
blnCancel = False
' Use PrintDialog to get the handle to a memory
' block with a DevMode and DevName structures
With PrintDlg
.lStructSize = Len(PrintDlg)
.hwndOwner = 0
.Flags = Flags
.nMinPage = intMinPage
.nFromPage = intFromPage
.nToPage = intToPage
.nMaxPage = intMaxPage
End With
'Set the current orientation and duplex setting
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmSize = Len(DevMode)
DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
DevMode.dmOrientation = Printer.Orientation

DevMode.dmPaperSize = Printer.PaperSize
DevMode.dmScale = 2
DevMode.dmPaperLength = 148
DevMode.dmPaperWidth = 210

On Error Resume Next
DevMode.dmDuplex = Printer.Duplex
On Error GoTo 0
'Allocate memory for the initialization hDevMode structure
'and copy the settings gathered above into this memory
PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
GMEM_ZEROINIT, Len(DevMode))
lpDevMode = GlobalLock(PrintDlg.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
intReturn = GlobalUnlock(lpDevMode)
End If
'Set the current driver, device, and port name strings
With DevName
.wDriverOffset = 8
.wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
.wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
.wDefault = 0
End With
With Printer
DevName.extra = .DriverName & Chr(0) & _
.DeviceName & Chr(0) & .Port & Chr(0)
End With
'Allocate memory for the initial hDevName structure
'and copy the settings gathered above into this memory
PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
GMEM_ZEROINIT, Len(DevName))
lpDevName = GlobalLock(PrintDlg.hDevNames)
If lpDevName > 0 Then
CopyMemory ByVal lpDevName, DevName, Len(DevName)
intReturn = GlobalUnlock(lpDevName)
End If
'Call the print dialog up and let the user make changes
If PrintDialog(PrintDlg) Then
'First get the DevName structure.
lpDevName = GlobalLock(PrintDlg.hDevNames)
CopyMemory DevName, ByVal lpDevName, 45
intReturn = GlobalUnlock(lpDevName)
With PrintDlg
Flags = .Flags
intFromPage = .nFromPage
intToPage = .nToPage
End With
GlobalFree PrintDlg.hDevNames
'Next get the DevMode structure and set the printer
'properties appropriately
lpDevMode = GlobalLock(PrintDlg.hDevMode)
CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
intReturn = GlobalUnlock(PrintDlg.hDevMode)
GlobalFree PrintDlg.hDevMode
strNewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
If Printer.DeviceName <> strNewPrinterName Then
For Each objPrinter In Printers
If UCase$(objPrinter.DeviceName) = strNewPrinterName Then _
Set Printer = objPrinter
Next
End If
On Error Resume Next
'Set printer object properties according to selections made
'by user
With Printer
.Copies = DevMode.dmCopies
.Duplex = DevMode.dmDuplex
.Orientation = DevMode.dmOrientation
.PaperSize = DevMode.dmPaperSize

End With
On Error GoTo 0
Else
GlobalFree PrintDlg.hDevMode
GlobalFree PrintDlg.hDevNames
blnCancel = True
If CancelError Then _
Err.Raise cdlCancel, "LM PrintDialog", "Cancel."
End If
ShowPrinter = Not blnCancel
End Function


'modStart.bas 文件：
Option Explicit

Sub main()
Dim P As New clsPrintDialog
P.Flags = cdlPDPageNums + cdlPDDisablePrintToFile + cdlPDNoSelection
P.Min = 1
P.FromPage = 3
P.ToPage = 5
P.Max = 100


Printer.PaperSize = 11
Printer.Orientation = 2

P.ShowPrinter


'Debug.Print Printer.DeviceName
'Debug.Print Printer.Copies
'Debug.Print P.FromPage
'Debug.Print P.ToPage
Debug.Print Printer.PaperSize
Debug.Print Printer.Orientation

' Write here Print Code with Printer Object...
End Sub

[无言无忌]

何不使用Crystal Report, 它可以让你在设计报表时就确定用横向或纵向打印，绝不需要运行进行人工干预。Crystal Report只在VB5中提供。

[masterkey]

我看playyuer的回答完全来自另外一个站点的内容，就给30分吧！

[lisonlee]

楼上的朋友，你解决了这个问题吗，如果你看到此回复的话，请你帮个忙，我也碰到和你一样的问题，只是playyuer的程序不是很易懂，请你发一个解决此方法的demo给我，行吗？我的mail:[e-mail]　。先谢了。