Программа процедуры печати отчета из DBGrid(как ей пользоваться - см. статью о печати отчетов). Модифицирована и подправлена. Добавлен перенос слов
в длинной строке.
Добавлены более-менее приличные комментарии. По-видимому
изменения будут продолжаться, поскольку подобные задачки постоянно встречаются
мне в работе.
Private Sub cmdPrint_Click()
'***********************************************************
'* Процедура печати данных из DBgrid *
'*********************************************************** Dim c As Integer 'Номер строки Dim Dob ' Добавочная поправка к ширине столбца для привязки
'к ширине страницы Dim FlagStrWrap(15) As Integer ' Флаг переноса строки Dim i As Integer ' Номер записи в таблице Dim NumDob As Integer
Dim OStrWidth
Dim sss(15)
Dim Str As String
Dim StrWidth(15) ' Ширина столбца Dim StrWrap As String
Dim StrWrapOst As String
Dim StWidth(15)
Dim title As String ' Заголовок таблицы Dim w As Integer ' Позиция пробела Dim x As Integer 'Координата позиции печати X Dim xRom As Integer ' Хранит приращение координаты X при
'переносе строки Dim xx As Integer 'Приращение координаты X Dim Y As Integer 'Координата позиции печати Y Dim z As Integer ' Номер столбца (в 1-м цикле) Dim zz As Integer ' Номер столбца (во 2-м вложенном цикле) Dim zzz As Integer ' Номер столбца (в 3-м вложенном цикле) MousePointer = 11
'Задание пользовательской системы координат x = Printer.ScaleWidth * 0.01
Y = Printer.ScaleHeight * 0.02
'Установка свойств объекта Printer Printer.FontName = "Arial Cyr"
Printer.FontSize = 10
Printer.FontBold = False
'***************************************
'Предварительный расчет ширины столбцов
'***************************************
'Считывание названий полей из DBGrid For z = 0 To Grid.Columns.Count - 1 Step 1
StrWidth(z) = Grid.Columns(z).DataField
Next z
'Измерение максимальной ширины текстовых данных в
'столбцах DBGrid DataReport.Recordset.MoveFirst
For i = 0 To DataReport.Recordset.RecordCount - 1
For z = 0 To Grid.Columns.Count - 1 Step 1
Str = DataReport.Recordset.Fields(Grid.Columns(z).DataField).Value
If Len(Str) > Len(StrWidth(z)) Then
'Проверка на превышение допустимой длины строки If Printer.TextWidth(Str) > 25 * x Then
StrWrap = Left(Str, InStr(w + 1, Str, " ", vbTextCompare) - 1)
VarWidth:
If Printer.TextWidth(StrWrap) < 25 * x Then
w = InStr(w + 1, Str, " ") ' следующая позиция пробела StrWrap = Left(Str, InStr(w + 1, Str, " ", vbTextCompare) - 1)
If Not InStr(w + 1, Str, " ", vbTextCompare) - 1 = 0 Then GoTo VarWidth
End If
StrWidth(z) = StrWrap
GoTo 610
End If
StrWidth(z) = Grid.Columns(z).Text
610 End If
Next z
DataReport.Recordset.MoveNext
Next i
DataReport.Recordset.MoveFirst
Str = 0
c = 1
xx = 12
For z = 0 To Grid.Columns.Count - 1 Step 1
StWidth(z) = Printer.TextWidth(StrWidth(z))
OStrWidth = OStrWidth + StWidth(z)
Next z
'Учет незадействованной ширины листа и равномерное
'распределение ее по столцам Dob = (Printer.ScaleWidth - OStrWidth - 1847) / _
(Grid.Columns.Count - 1)
If Dob < 1 Then GoTo 10
NumDob = (Printer.ScaleWidth - OStrWidth - 1847) / Dob
For z = 0 To NumDob Step 1
StWidth(z) = StWidth(z) + Dob
Next z
'*********************
'Формирование таблицы
'*********************
'Печать заголовка таблицы Grid10 xx = 8
title = Grid.Caption
c = c + 1
Printer.FontSize = 8
Printer.CurrentX = (Printer.ScaleWidth - Printer.TextWidth(title)) / 2
Printer.CurrentY = Y * c
Printer.Print title
c = c + 1
'Печать вертикальной линии шапки таблицы Printer.DrawWidth = 2
Printer.Line (x * 8, Y * c)-(x * 94, Y * c)
Printer.DrawWidth = 1
'Печать названий столбцов For z = 0 To Grid.Columns.Count - 1 Step 1
sss(z) = Grid.Columns(z).DataField
Printer.CurrentX = x * (xx + 0.4)
Printer.CurrentY = Y * (c + 0.2)
Printer.Print sss(z)
xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100))
Next z
xx = 8
'Печать вертикальных разделительных линий For z = 0 To Grid.Columns.Count - 1 Step 1
If z = 0 Then
Printer.DrawWidth = 2
Else
Printer.DrawWidth = 1
End If
Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1))
xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100))
Next z
Printer.DrawWidth = 2
Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1))
Printer.DrawWidth = 1
c = c + 1
xx = 8
'**************
'Печать данных
'************** DataReport.Recordset.MoveFirst
For i = 0 To DataReport.Recordset.RecordCount - 1
For z = 0 To Grid.Columns.Count - 1 Step 1'******************************************************
'Проверка, не превысило ли количество строк назначенное
'для страницы значение If c > 38 Then
'Завершение текущей страницы Printer.CurrentX = x * 84
Printer.CurrentY = Y * (39.1)
Printer.Print "Стр. "; Printer.page
Printer.DrawWidth = 2
Printer.Line (x * 8, Y * c)-(x * 94, Y * c)
Printer.DrawWidth = 1
'**********************
'Начало новой страницы
'********************** Printer.NewPage
c = 1
'Печать верхней линии шапки таблицы Printer.DrawWidth = 2
Printer.Line (x * 8, Y * c)-(x * 94, Y * c)
Printer.DrawWidth = 1
'Печать названия столбцов For zz = 0 To Grid.Columns.Count - 1 Step 1
sss(zz) = Grid.Columns(zz).DataField
Printer.CurrentX = x * (xx + 0.4)
Printer.CurrentY = Y * (c + 0.2)
Printer.Print sss(zz)
xx = xx + (StWidth(zz) / (Printer.ScaleWidth / 100))
Next zz
xx = 8
'Печать вертикальных разделительных линий For zz = 0 To Grid.Columns.Count - 1 Step 1
If zz = 0 Then
Printer.DrawWidth = 2
Else
Printer.DrawWidth = 1
End If
Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1))
xx = xx + (StWidth(zz) / (Printer.ScaleWidth / 100))
Next zz
'Печать крайней правой вертикальной линии Printer.DrawWidth = 2
Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1))
Printer.DrawWidth = 1
c = c + 1
xx = 8
End If
'Окончание цикла, предназначенного для перехода на новую
'страницу
'************************************************************
'печать данных Printer.CurrentX = x * (xx + 0.4)
Printer.CurrentY = Y * (c + 0.2)
Str = DataReport.Recordset.Fields(Grid.Columns(z) _
.DataField).Value
'проверка, не превышает ли длина данных в строке
'величину в 25 позиций печати для последующей
'организации переноса оставшейся части строки If Printer.TextWidth(Str) > 25 * x Then
Transportation:
StrWrap = Left(Str, InStr(w + 1, Str, " ") - 1)
If Printer.TextWidth(StrWrap) < 25 * x Then
w = InStr(w + 1, Str, " ")
GoTo Transportation
End If
Str = StrWrap
'Установка флага переноса строки FlagStrWrap(z) = 1
xRom = xx
StrWrapOst = Mid(DataReport.Recordset.Fields(Grid.Columns(z) _
.DataField).Value, Len(Str) + 1)
Else
FlagStrWrap(z) = 0
End If
Printer.Print Str
xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100))
Next z
'Печать вертикальных разделительных линий xx = 8
For z = 0 To Grid.Columns.Count - 1 Step 1
If z = 0 Then
Printer.DrawWidth = 2
Else
Printer.DrawWidth = 1
End If
Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1))
xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100))
Next z
Printer.DrawWidth = 2
Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1))
Printer.DrawWidth = 1
Printer.Line (x * 8, Y * c)-(x * 94, Y * c)
c = c + 1
DataReport.Recordset.MoveNext
'*****************************************
'Печать остатка строки
'*****************************************
For zz = 0 To Grid.Columns.Count - 1 Step 1
If FlagStrWrap(zz) = 1 Then
xx = xRom
Printer.CurrentX = x * (xx + 0.4)
Printer.CurrentY = Y * (c + 0.2)
Printer.Print StrWrapOst
xx = 8
For zzz = 0 To Grid.Columns.Count - 1 Step 1
If zzz = 0 Then
Printer.DrawWidth = 2
Else
Printer.DrawWidth = 1
End If
Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1))
Printer.DrawWidth = 2
Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1))
Printer.DrawWidth = 1
xx = xx + (StWidth(zzz) / (Printer.ScaleWidth / 100))
Next zzz
c = c + 1
End If
Next zz
xx = 8
Next i
DataReport.Recordset.MoveFirst
Printer.DrawWidth = 1
Printer.Line (x * 8, Y * c)-(x * 94, Y * c)
'Печать суммирующей строки из DBGrid Grid2 For z = 0 To Grid.Columns.Count - 1 Step 1
If z = Grid.Columns.Count - 3 Then
Printer.CurrentX = x * (xx + 0.4)
Printer.CurrentY = Y * (c + 0.2)
'Печать названия итоговой величины из DBGrid Grid2 Printer.Print Grid2.Columns(0).DataField
End If
If z = Grid.Columns.Count - 1 Then
Printer.CurrentX = x * (xx + 0.4)
Printer.CurrentY = Y * (c + 0.2)
'Печать итоговой суммы из DBGrid Grid2 Printer.Print Grid2.Columns(0).Text
End If
xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100))
Next z
Printer.DrawWidth = 2
Printer.Line (x * 8, Y * c)-(x * 8, Y * (c + 1))
Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1))
c = c + 1
Printer.Line (x * 8, Y * c)-(x * 94, Y * c)
Printer.DrawWidth = 1
Printer.CurrentX = x * 84
Printer.CurrentY = Y * 39.1
Printer.Print "Стр. "; Printer.page
'Завершение построения отчета и физическая печать MousePointer = 0
Printer.EndDoc
PrintError:
MousePointer = 0
End Sub