'***************************************************************
' Подписка: "Access 2000 - программирование и готовые решения"
' Тема: Отчеты Access
' Версия: 1 от 30.10.2000
' Автор: Copyright © Leader Access, Ltd
' Сайт: http://www.leadersoft.ru
' Почта: support@leadersoft.ru
' Примечание: Код изменен из справочной системы Access.
'
Option Compare Database
Option Explicit
'***************************************************************
'15.Пример. Как изменить размеры листа отчета ?
'***************************************************************
Private Type str_DEVMODE
RGB As String * 94 'Промежуточная переменная для копирования
End Type
'Полное описание структуры дано в модуле: p001.mdb
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
intPaperSize As Integer
intPaperLength As Integer
intPaperWidth As Integer
intScale As Integer
intCopies As Integer
intDefaultSource As Integer
intPrintQuality As Integer
intColor As Integer
intDuplex As Integer
intResolution As Integer
intTTOption As Integer
intCollate As Integer
strFormName As String * 16
lngPad As Long
lngBits As Long
lngPW As Long
lngPH As Long
lngDFI As Long
lngDFr As Long
End Type
'==============================================================
' Открытие отчета
Private Sub Form_Open(Cancel As Integer)
funChangeReport False
End Sub
'==============================================================
' Открыть отчет
Private Sub butChange_Click()
On Error GoTo 999
DoCmd.OpenReport "Пример 16", acViewPreview 'Открываем конструктор отчета
Exit Sub
999:
MsgBox Err.Description
Err.Clear
End Sub
'==============================================================
' Изменяем размеры отчета
Private Sub myWidth_AfterUpdate()
funChangeReport True
End Sub
'==============================================================
' Изменяем размеры отчета
Private Sub myLength_AfterUpdate()
funChangeReport True
End Sub
'==============================================================
' Изменяем размеры отчета
'
Private Sub funChangeReport(boolChange As Boolean)
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
Dim rpt As Report
On Error GoTo 999
DoCmd.OpenReport "Пример 16", acDesign 'Открываем конструктор отчета
Set rpt = Reports("Пример 16") 'Определяем адрес отчета
If Not IsNull(rpt.PrtDevMode) Then
strDevModeExtra = rpt.PrtDevMode
DevString.RGB = strDevModeExtra 'Структура отчета
LSet DM = DevString 'Заполняем структуру
If boolChange = True Then 'Изменение отчета
On Error Resume Next
rpt.Width = 32000
Err.Clear
DM.lngFields = DM.lngFields Or _
DM.intPaperSize Or DM.intPaperLength Or DM.intPaperWidth
DM.intPaperSize = 256 'Устанавливаем тип листа
DM.intPaperWidth = Me.myWidth * 10 'Новая ширина
DM.intPaperLength = Me.myLength * 10 'Новая длина
LSet DevString = DM 'Обновляем свойство
Mid(strDevModeExtra, 1, 94) = DevString.RGB
rpt.PrtDevMode = strDevModeExtra
DoCmd.Close acReport, "Пример 16", acSaveYes 'Закрываем отчет
Else 'Отображение данных
Me.myWidth = DM.intPaperWidth / 10 'Ширина
Me.myLength = DM.intPaperLength / 10 'Ширина
DoCmd.Close acReport, "Пример 16" 'Закрываем отчет
End If
End If
Exit Sub
999:
MsgBox Err.Description
End Sub
'==============================================================
' Отобразить VBA код
Private Sub butVBA_Click()
DoCmd.OpenModule Me.Module
End Sub
|