|
|
Модуль переустановки "принтерных" настроек всех отчетов под текущий принтер по умолчанию
Ситуация:
.... у разработчика (отчетов), допустим был:
HP LaserJet с EconoMode = OFF, а у пользователя некий: Epson Stylus COLOR и уже EconoMode = ON
...и не смотря на это "ON" - отчеты все равно расходуют чернила "На полную катушку". (параметры печати сохраняются в отчете)
На эту тему сочинилось такое решение:
Option Compare Database
Option Explicit
Private Type str_DEVMODE
RGB As String * 94
End Type
Private 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
End Type
Public Sub esResetAllReportsToDefPrinter()
Dim dbs As Database, ctr As Container, doc As Document
Dim objReport As Report
Dim OldOrientation As Integer
On Error GoTo esResetAllReportsToDefPrinterErr
Application.Echo False
Set dbs = CurrentDb
Set ctr = dbs.Containers!Reports
For Each doc In ctr.Documents
DoCmd.OpenReport doc.name, acViewDesign
Set objReport = Reports(doc.name)
SysCmd acSysCmdSetStatus, "Обрабатываю Отчет - " & doc.name
OldOrientation = esReportOrientationSetGet(objReport, True)
objReport.PrtDevMode = Null
objReport.PrtDevNames = Null
DoCmd.Close acReport, doc.name, acSaveYes
If OldOrientation = 2 Then
DoCmd.OpenReport doc.name, acViewDesign
Set objReport = Reports(doc.name)
esReportOrientationSetGet objReport
DoCmd.Close acReport, doc.name, acSaveYes
End If
Next doc
SysCmd (acSysCmdClearStatus)
Application.Echo True
Exit Sub
esResetAllReportsToDefPrinterErr:
Application.Echo True
MsgBox "Процедура [esResetAllReportsToDefPrinter] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number & vbCrLf & _
"При обработке Отчета - " & doc.name, vbCritical
End Sub
Private Function esReportOrientationSetGet(objCurReport As Report, _
Optional GetOnly As Boolean) As Integer
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
On Error GoTo esReportOrientationSetGetErr
If Not IsNull(objCurReport.PrtDevMode) Then
strDevModeExtra = objCurReport.PrtDevMode
DevString.RGB = strDevModeExtra
LSet DM = DevString
esReportOrientationSetGet = DM.intOrientation
If GetOnly = False Then
DM.intOrientation = 2
LSet DevString = DM
Mid(strDevModeExtra, 1, 94) = DevString.RGB
objCurReport.PrtDevMode = strDevModeExtra
End If
End If
Exit Function
esReportOrientationSetGetErr:
If GetOnly = True Then
strDevModeExtra = "При определении ориентации Отчета - " & _
objCurReport.name
Else
strDevModeExtra = "При установке ориентации Отчета - " & _
objCurReport.name
End If
MsgBox "Процедура [esReportOrientationSetGet] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number & vbCrLf & _
strDevModeExtra, vbCritical
End Function
|
|