Код

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

Private Type DEVMODE
	  dmDeviceName As String * CCHDEVICENAME
	  dmSpecVersion As Integer
	  dmDriverVersion As Integer
	  dmSize As Integer
	  dmDriverExtra As Integer
	  dmFields As Long
	  dmOrientation As Integer
	  dmPaperSize As Integer
	  dmPaperLength As Integer
	  dmPaperWidth As Integer
	  dmScale As Integer
	  dmCopies As Integer
	  dmDefaultSource As Integer
	  dmPrintQuality As Integer
	  dmColor As Integer
	  dmDuplex As Integer
	  dmYResolution As Integer
	  dmTTOption As Integer
	  dmCollate As Integer
	  dmFormName As String * CCHFORMNAME
	  dmUnusedPadding As Integer
	  dmBitsPerPel As Long
	  dmPelsWidth As Long
	  dmPelsHeight As Long
	  dmDisplayFlags As Long
	  dmDisplayFrequency As Long
End Type

Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As DEVMODE) As Long 

Код

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type CharRange
    cpMin As Long ' First character of range (0 for start of doc)
    cpMax As Long ' Last character of range (-1 for end of doc)
End Type

Private Type FormatRange
    hdc As Long ' Actual DC to draw on
    hdcTarget As Long ' Target DC for determining text formatting
    rc As RECT ' Region of the DC to draw to (in twips)
    rcPage As RECT ' Region of the entire DC (page size) (in twips)
    chrg As CharRange ' Range of text to draw (see above declaration)
End Type

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, TopMarginHeight, RightMarginWidth, BottomMarginHeight)
    Dim LeftOffset As Long, TopOffset As Long
    Dim LeftMargin As Long, TopMargin As Long
    Dim RightMargin As Long, BottomMargin As Long
    Dim fr As FormatRange
    Dim rcDrawTo As RECT
    Dim rcPage As RECT
    Dim TextLength As Long
    Dim NextCharPosition As Long
    Dim r As Long

    ' Start a print job to get a valid Printer.hDC
    Printer.Print Space(1)
    Printer.ScaleMode = vbTwips

    ' Get the offsett to the printable area on the page in twips
    ' some code here
    LeftOffset = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX) / GetDeviceCaps(Printer.hdc, LOGPIXELSX) * 1440
    TopOffset = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY) / GetDeviceCaps(Printer.hdc, LOGPIXELSY) * 1440

    ' Calculate the Left, Top, Right, and Bottom margins
    ' some code here
    LeftMargin = LeftMarginWidth - LeftOffset
    TopMargin = TopMarginHeight - TopOffset
    RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
    BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset

    ' Set printable area rect
    ' some code here
    rcPage.Left = 0
    rcPage.Top = 0
    rcPage.Right = Printer.ScaleWidth
    rcPage.Bottom = Printer.ScaleHeight

    ' Set rect in which to print (relative to printable area)
    ' some code here
    rcDrawTo.Left = LeftMargin
    rcDrawTo.Top = TopMargin
    rcDrawTo.Right = RightMargin
    rcDrawTo.Bottom = BottomMargin

    ' Set up the print instructions
    fr.hdc = Printer.hdc ' Use the same DC for measuring and rendering
    fr.hdcTarget = Printer.hdc ' Point at printer hDC
    fr.rc = rcDrawTo ' Indicate the area on page to draw to
    fr.rcPage = rcPage ' Indicate entire size of page
    fr.chrg.cpMin = 0 ' Indicate start of text through
    fr.chrg.cpMax = -1 ' end of the text

    ' Get length of text in RTF
    TextLength = Len(RTF.Text)

    ' Loop printing each page until done
    Do
	  ' Print the page by sending EM_FORMATRANGE message
	  NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)
	  If NextCharPosition >= TextLength Then Exit Do 'If done then exit
	  fr.chrg.cpMin = NextCharPosition ' Starting position for next page
	  Printer.NewPage ' Move on to next page
	  Printer.Print Space(1) ' Re-initialize hDC
	  fr.hdc = Printer.hdc
	  fr.hdcTarget = Printer.hdc
    Loop

    ' Commit the print job
    Printer.EndDoc

    ' Allow the RTF to free up memory
    r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, 0&)
End Sub

Private Sub Command1_Click()
    PrintRTF Me.RichTextBox1, 1440, 1440, 1440, 1440
End Sub