Форумы HiProg.com - MS ACCESS, VBA, VB

ник: Дядя Федор
В ДОГОНКУ ПРИМЕР ИЗ REFER XP(Егорова)
Вопрос: Модуль переустановки "принтерных" настроек всех отчетов под текущий принтер по умолчанию

Совет:

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

Option Compare Database Option Explicit 'js = 23.10.2001 'Модуль ПЕРЕУСТАНОВКИ "принтерных" настроек всех отчетов 'под текущий принтер по умолчанию т.е. с настроек принтера ' разработчика на настройки принтера пользователя '=============================================================== 'см справку по Свойству PrtDevMode '=============================================================== 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 jsResetAllReportsToDefPrinter() 'Смена у всех отчетов настроек принтера с "зашитых внутри отчета" ' на текущий принтер по умолчанию и его настройки ' затирает только данные по принтеру - поля и ориентация остаются прежними     Dim dbs As Database, ctr As Container, doc As Document     Dim objReport As Report     Dim OldOrientation As Integer 'Для запоминания старой ориентации     'Т.к. она (ориентация) входит в Свойство PrtDevMode отчета     'кое собираемся переписывать по новой      On Error GoTo jsResetAllReportsToDefPrinterErr 'Выключ. отображение процесса 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 = jsReportOrientationSetGet(objReport, True)             'Зачистка данных о принтере в отчете             objReport.PrtDevMode = Null             objReport.PrtDevNames = Null             'Закрытие отчета с сохранением "пустого принтера"             DoCmd.Save acReport, doc.Name             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 то восстанавливать нет необходимости                 'т.к. она уже установлена по умолчанию                 Call jsReportOrientationSetGet(objReport)                 'Закрытие отчета                 DoCmd.Close acReport, doc.Name, acSaveYes             End If     Next doc SysCmd (acSysCmdClearStatus) 'Включаем отображение процесса на экране обратно Application.Echo True Exit Sub jsResetAllReportsToDefPrinterErr:     Application.Echo True     MsgBox Err.Description & vbCrLf & "При обработке Отчета - " & _     doc.Name, vbCritical End Sub '=============================================================== Private Function jsReportOrientationSetGet(objCurReport As Report, _                     Optional GetOnly As Boolean) As Integer 'Вспомогательная функция ,в зависимости от параметра GetOnly, 'ИЛИ : 'Возвращает код ориентации отчета Portrait=1 '.... или LandsCape=2 (если GetOnly=True) 'ИЛИ : '(если GetOnly=False | не указан (по умолчанию)) 'делает ориентацию открытого отчета = LandsCape Dim DevString As str_DEVMODE Dim DM As type_DEVMODE Dim strDevModeExtra As String On Error GoTo jsReportOrientationSetGetErr     If Not IsNull(objCurReport.PrtDevMode) Then         strDevModeExtra = objCurReport.PrtDevMode         DevString.RGB = strDevModeExtra         LSet DM = DevString         jsReportOrientationSetGet = 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 jsReportOrientationSetGetErr:     If GetOnly = True Then         strDevModeExtra = "При определении ориентации Отчета - " & _         objCurReport.Name     Else         strDevModeExtra = "При установке ориентации Отчета - " & _         objCurReport.Name     End If     MsgBox Err.Description & vbCrLf & strDevModeExtra, vbCritical     Err.Clear End Function '=============================================================== '(c) из справочника Егорова