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
    '*********************
    'Формирование таблицы
    '*********************
    'Печать заголовка таблицы Grid
10  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