ник: Чайник2007
Может это поможет покопайся.
----------------------------------
Модуль переустановки "принтерных" настроек всех отчетов под текущий принтер по умолчанию
Ситуация:
.... у разработчика (отчетов), допустим был:
HP LaserJet с EconoMode = OFF,
у пользователя же, некий:
Epson Stylus COLOR и уже EconoMode = ON
...и не смотря на это "ON" отчеты все равно расходуют чернила "На полную катушку". К тому же, то - что пишут эти драйвера за 94-й байт свойства PrtDevMode (мне) абсолютно неизвестно.
На эту тему сочинилось такое решение:
'===============================================================
'es 17.01.04
'Модуль ПЕРЕУСТАНОВКИ "принтерных" настроек всех отчетов
'под текущий принтер по умолчанию т.е. с настроек принтера разработчика
'на настройки принтера пользователя
'===============================================================
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.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 то восстанавливать нет необходимости
' т.к. она уже установлена по умолчанию
jsReportOrientationSetGet objReport
'Закрытие отчета с сохранением
DoCmd.Close acReport, doc.Name, acSaveYes
End If
Next doc
SysCmd (acSysCmdClearStatus)
'Включаем отображение процесса на экране обратно
Application.Echo True
Exit Sub
jsResetAllReportsToDefPrinterErr:
Application.Echo True
MsgBox "Процедура [jsResetAllReportsToDefPrinter] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number & vbCrLf & _
"При обработке Отчета - " & doc.Name, vbCritical
End Sub
'===============================================================
Private Function jsReportOrientationSetGet(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 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 "Процедура [jsReportOrientationSetGet] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number & vbCrLf & _
strDevModeExtra, vbCritical
End Function