'--------------------------------------------------------------------
' 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