*P.S> I do not know Visual Basic, so if that is an option, please provide
specific details on how to use it to perform this function!
To do this, you've got to use Visual Basic (and this technique won't work
with an mde db.) I've listed below code which you can use by attaching it
to the "onClick" event of a print button on your form. (set the report to
use the default printer first.) There's lots of code, you can cut an past
it into a general module. Then, specify portrait or landscape as necessary
when printing. A sample call would be:
Dim Result as Boolean
Result = PrintLandscape("TheNameofSomeReport")
HTH
--
Steve Arbaugh
ATTAC Consulting Group
http://ourworld.compuserve.com/homepages/attac-cg
'---------begin code, cut and paste below this line--------------
Const DEBUGRPT = False 'See atLockWindow for explaination
Type str_DEVMODE
RGB As String * 94
End Type
Type type_DEVMODE
strDeviceName As String * 16
intSpecVersion As Integer
intDriverVersion As Integer
intSize As Integer
intDriverExtra As Integer
lngFields As Long
intOrientation As Integer
intPaperSize As Integer
intPaperLength As Integer
intPaperWidth As Integer
intScale As Integer
intCopies As Integer
intDefaultSource As Integer
intPrintQuality As Integer
intColor As Integer
intDuplex As Integer
intResolution As Integer
intTTOption As Integer
intCollate As Integer
strFormName As String * 16
lngPad As Long
lngBits As Long
lngPW As Long
lngPH As Long
lngDFI As Long
lngDFr As Long
End Type
Private Declare Function api_FindWindow32 Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As Any) As Long
Private Declare Function api_LockWindow32 Lib "user32" Alias
"LockWindowUpdate" (ByVal hwndLock As Long) As Long
Private Declare Function api_DestroyWindow32 Lib "user32" Alias
"DestroyWindow" (ByVal hwnd As Long) As Long
Private Sub atLockWindow(TrueOrFalse As Boolean)
'---------------------------------------
'By ATTAC Consulting Group, Ann Arbor, MI
'Purpose: Lock the Window Update to main
' Access Window
'Accepts: Boolean True to Lock, False to unlock
'Note: DEBUGRPT is a debugging const in the declares
' Set to True there to eliminate window locks when debugging code!
' otherwise Access will appear locked when you reach a code
' breakpoint because the window is locked.
'---------------------------------------
On Error GoTo Err_Lock
Dim Status As Long
If TrueOrFalse = True And DEBUGRPT= 0 Then
Status = api_LockWindow32(Application.hWndAccessApp)
Else
Status = api_LockWindow32(0)
End If
Exit_Lock:
Exit Sub
Err_Lock:
MsgBox "Error " & Err & " " & Error$, , "atLockWindow Function"
Resume Exit_Lock
End Sub
Private Function atPrintLandscape(strRptName As String)
'---------------------
'By: ATTAC Consulting Group, Ann Arbor, MI USA
'Purpose: Assures that a report is printed on Landscape format
'Accepts: strRptName: Name of a Report to Print
'---------------------
On Error GoTo Err_CSS
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
Dim dwOK&
Const PAPERPORTRAIT = 1
Const PAPERLANDSCAPE = 2
If DEBUGRPT = False Then DoCmd.Echo False
DoCmd.OpenReport strRptName, acDesign
Reports(strRptName).Painting = False
DoCmd.ShowToolbar "Report Design", acToolbarNo
DoCmd.ShowToolbar "ToolBox", acToolbarNo
dwOK = api_DestroyWindow32(api_FindWindow32("OArgDlg", 0&))
dwOK = api_DestroyWindow32(api_FindWindow32("OEcl", 0&))
dwOK = api_DestroyWindow32(api_FindWindow32("OSnG", 0&))
Application.Echo True
Call atLockWindow(True)
If Not IsNull(Reports(strRptName).PrtDevMode) Then
strDevModeExtra = Reports(strRptName).PrtDevMode
DevString.RGB = strDevModeExtra
LSet DM = DevString
If DM.intOrientation <> PAPERLANDSCAPE Then
DoCmd.SetWarnings False
DM.intOrientation = PAPERLANSCAPE 'Set to Landscape
LSet DevString = DM
Mid(strDevModeExtra, 1, 94) = DevString.RGB
Reports(strRptName).PrtDevMode = strDevModeExtra
DoCmd.DoMenuItem 7, acFile, 4, , acMenuVer70
DoCmd.SetWarnings True
End If
End If
DoCmd.SelectObject acReport, strRptName
DoCmd.PrintOut acReport, strRptName
atPrintLandscape = True
CloseAll:
If DEBUGRPT = False Then Application.Echo False
Reports(strRptName).Painting = True
DoCmd.Close acReport, strRptName, acSaveNo
DoCmd.ShowToolbar "Report Design", acToolbarWhereApprop
DoCmd.ShowToolbar "ToolBox", acToolbarWhereApprop
DoCmd.SetWarnings True
Application.Echo True
Call atLockWindow(False)
Exit_CSS:
Exit Function
Err_CSS:
Select Case Err
Case 2103, 2451
atPrintLandscape = False
MsgBox "Error:@The report specified for printing: """ & strRptName &
""", is no longer valid, or the report is missing from this application.@@",
vbCritical, "Print Job Cancelled"
Application.Echo True
Call atLockWindow(False)
Resume Exit_CSS
Case 2601
atPrintLandscape = False
MsgBox "Error:@You don't have the proper permissions for """ &
strRptName & """ to allow it to be printed.@Contact your System
Administrator.@", vbCritical, "Print Job Cancelled"
Application.Echo True
Resume Exit_CSS
Case 2094 'Toolbar not found
Resume Next
Case Else
Application.Echo True
Call atLockWindow(False)
MsgBox "Error: " & Err & " " & Error, 16, "Set Paper Size"
Resume Exit_CSS
End Select
End Function
'-----------end code here---------------------
Deron & Cynthia Thompson <cdt...@prodigy.net> wrote in message
news:ey#J9nGh#GA...@cppssbbsa02.microsoft.com...