'--------------------------------------------------------------------
' Module : modReportsPrinterReset
' Author : es
' Date : 17.01.2004
'--------------------------------------------------------------------
'Module for Resetting all reports to the current default printer
'--------------------------------------------------------------------
'Модуль ПЕРЕУСТАНОВКИ "принтерных" настроек всех отчетов
'под текущий принтер по умолчанию т.е. с настроек принтера разработчика
'на настройки принтера пользователя
'--------------------------------------------------------------------
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
