Модуль переустановки "принтерных" настроек всех отчетов под текущий принтер по умолчанию

Ситуация:
.... у разработчика (отчетов), допустим был:
HP LaserJet с EconoMode = OFF, а у пользователя некий: Epson Stylus COLOR и уже EconoMode = ON
...и не смотря на это "ON" - отчеты все равно расходуют чернила "На полную катушку". (параметры печати сохраняются в отчете)

На эту тему сочинилось такое решение:

'--------------------------------------------------------------------

' Module : modReportsPrinterReset

' Author : es

' Date : 17.01.2004

'--------------------------------------------------------------------

'Модуль ПЕРЕУСТАНОВКИ "принтерных" настроек всех отчетов

'под текущий принтер по умолчанию т.е. с настроек принтера разработчика

'на настройки принтера пользователя

'--------------------------------------------------------------------

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 'Для запоминания старой ориентации _

т.к. она (ориентация) входит в Свойство PrtDevMode отчета _

кое собираемся переписывать по новой

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)

'отображение инфы о тек. отчете в Status Bar

SysCmd acSysCmdSetStatus, "Обрабатываю Отчет - " & doc.name

'Запоминаем старую ориентацию для последующего восстановления (см. функцию ниже)...

OldOrientation = esReportOrientationSetGet(objReport, True)

'Зачистка данных о принтере в отчете

objReport.PrtDevMode = Null

objReport.PrtDevNames = Null

'Закрытие отчета с сохранением "пустого принтера"

DoCmd.Close acReport, doc.name, acSaveYes

'Если до этого у отчета была ориентация LandsCape

' то восстанавливаем ее, причем отчет уже "берет"

' принтер по умолчанию, при повторном открытии

If OldOrientation = 2 Then

'открытие отчета в режиме редакции

DoCmd.OpenReport doc.name, acViewDesign

Set objReport = Reports(doc.name)

'Debug.Print objReport.Name

'Восстанавливаем LandsCape ориентацию (см. функцию ниже)

' если была Portrait то восстанавливать нет необходимости

' т.к. она уже установлена по умолчанию

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

'Вспомогательная функция ,в зависимости от параметра GetOnly,

'ИЛИ :

'Возвращает код ориентации отчета

' Portrait = 1

' LandsCape= 2

'ИЛИ если GetOnly=False (по умолчанию):

' делает ориентацию открытого отчета = LandsCape

'--------------------------------------------------------------------

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

'Меняем ориентацию = LandsCape

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