Private Sub RichTextBox1_SelChange()
Dim s1 As String
With RichTextBox1
  s1 = .SelFontName & " " & .SelFontSize
  If .SelBold Then s1 = s1 & " B"
  If .SelItalic Then s1 = s1 & " I"
  If .SelUnderline Then s1 = s1 & " U"
End With
Caption = s1
End Sub

Mike

By chance you wouldn't know how to prevent text from printing unless a
defined group of text fit on the same page, else start a new page and print
the defined text group on that page?  I have text and graphics which I would
like to keep together on the same page and I want to make sure when it
prints it will always be in the same page.

Thanks,
Tim

How are you printing your page(s)?

Let me know *exactly* what you are printing and *exactly* how you are
printing it and I may be able to help you.

Mike

I use a similar technique as in the VBKB for WYSIWYG printing. I have a form
with one RichTextBox control whereby I read-in database fields into it like
a continuous stream. Some of the fields contain graphic images. I extract
them and place them into the RichTextBox using the clipboard. I also have a
Print Preview form using picture controls. This all works fine except that I
wish to have each record (image, and 3 memo fields of text) display on the
same page together. If they do not fit on the current page together I wish
to start a new page. Here is my printing technique:

Sub DocPrintProc()
    On Error Resume Next
    DoEvents
    frmRTPreview.picP.Picture = LoadPicture()

    Dim gcdg As Object
    Dim mFromPage As Integer, mToPage As Integer, mpage As Integer
    Dim mSelective As Boolean
    Dim mHwnd As Long

    Set gcdg = frmRTDoc.comDlg

    gcdg.DialogTitle = "Print"
    gcdg.CancelError = True

    gcdg.Flags = 0
    gcdg.Flags = cdlPDReturnDC
      ' Allow user select page range
    gcdg.Min = 1                           ' Must set to work around MS bug
    gcdg.Max = currTotalPages
    gcdg.FromPage = 1                      ' To force open up page selection
    gcdg.ToPage = currTotalPages

    If Len(frmRTDoc.Text1.SelText) > 0 Then
         gcdg.Flags = gcdg.Flags + cdlPDSelection + cdlPDPageNums
    Else
         gcdg.Flags = gcdg.Flags + cdlPDNoSelection + cdlPDPageNums
    End If

    gcdg.ShowPrinter

    If err = MSComDlg.cdlCancel Then
         Exit Sub
    End If

    mSelective = False
    If (gcdg.Flags And cdlPDSelection) <> 0 Then
         'If Len(frmRTFrame.ActiveForm.Text1.SelText) = 0 Then
         If Len(frmRTDoc.Text1.SelText) = 0 Then
              MsgBox "No selected text yet"
              Exit Sub
         End If
         mSelective = True
    End If

    If frmRTDoc.WindowState <> 1 Then
    Else
        MsgBox "Cannot proceed with minimized screen"
        Exit Sub
    End If

    'If MsgBox("Proceed to print", vbYesNo + vbQuestion) = vbNo Then
    '    Exit Sub
    'End If

    DocWYSIWYG frmRTDoc.Text1
    frmRTDoc.Move 0, 0

    'mHwnd = frmRTFrame.ActiveForm.Text1.hwnd            ' Assume first
    mHwnd = frmRTDoc.Text1.hWnd            ' Assume first

    If (gcdg.Flags And cdlPDPageNums) <> 0 Then
        mFromPage = gcdg.FromPage
        mToPage = gcdg.ToPage
    Else
        mFromPage = 1
        mToPage = currTotalPages
          ' If print selection only, transcribe selected contents to
textHidden for print
         '-----------------------------------
          ' Note that the SelPrint sends only the selected text to the
target device, hence
          ' the following would otherwise be OK if not because (i) it does
not let us have
          ' a control over the print margins and (ii) it does not allow us
to include
          ' pictures.
          'If (gcdg.Flags And cdlPDSelection) <> 0 Then
          '    Printer.Print ""
          '    frmRTFrame.ActiveForm.Text1.SelPrint gcdg.hdc
          '    Exit Sub
          'End If
         '-----------------------------------
        If mSelective Then
            'frmRTFrame.ActiveForm.TextHidden.Text = ""
            frmRTDoc.TextHidden.Text = ""
            DocWYSIWYG frmRTDoc.TextHidden
               ' We could directly transcribe Seltext into textHidden, but
then it covers
               ' text only - it would not cover a picture as well.
Therefore, we have to
               ' do the following workaround.
            'frmRTFrame.ActiveForm.picHidden.Picture = LoadPicture()
            frmRTDoc.picHidden.Picture = LoadPicture()
               ' Due to implications of having a picture in our printout,
each time we
               ' allow one page only.
            frmRTDoc.picHidden.Width = frmRTDoc.Text1.Width
            frmRTDoc.picHidden.Height = frmRTDoc.Text1.Height
            frmRTDoc.Text1.SelPrint frmRTDoc.picHidden.hdc
            frmRTDoc.picHidden.Picture = frmRTDoc.picHidden.Image

            Clipboard.Clear
            Clipboard.SetData frmRTDoc.picHidden.Picture
            SendMessage frmRTDoc.TextHidden.hWnd, WM_PASTE, 0, 0

            mHwnd = frmRTDoc.TextHidden.hWnd        ' We change earlier
value
        End If
    End If

    Printer.Print ""
    Printer.ScaleMode = vbTwips

      ' Set printable rect area
    rectPage.left = 0
    rectPage.top = 0
    rectPage.Right = Printer.ScaleWidth
    rectPage.Bottom = Printer.ScaleHeight

      ' Set rect in which to print (relative to printable area)
    rectDrawTo.left = gLeftMargin * 1440
    rectDrawTo.top = gTopMargin * 1440
    rectDrawTo.Right = Printer.ScaleWidth - gRightMargin * 1440
    rectDrawTo.Bottom = Printer.ScaleHeight - gBottomMargin * 1440

     ' Dump earlier pages if any to PicP before reaching first wanted page
    mFormatRange.hdc = frmRTPreview.picP.hdc
    mFormatRange.hdcTarget = frmRTPreview.picP.hdc

    newStartPos = 0                                   ' Next char to start
    mFormatRange.rectRegion = rectDrawTo              ' Area on page to draw
to
    mFormatRange.rectPage = rectPage                  ' Entire size of page
    mFormatRange.mCharRange.firstChar = newStartPos   ' Start of text
    mFormatRange.mCharRange.lastChar = -1             ' End of the text

'    If Not mSelective Then
'        TextLength = Len(frmRTFrame.ActiveForm.Text1.Text)
'    Else
'        TextLength = Len(frmRTFrame.ActiveForm.TextHidden.Text)
'    End If
    If Not mSelective Then
        TextLength = Len(frmRTDoc.Text1.Text)
    Else
        TextLength = Len(frmRTDoc.TextHidden.Text)
    End If

      ' Dumping if any
    mpage = 1
    Do
        If mpage = mFromPage Then
            Exit Do
        End If

        ' Don't clear picture box here, unless you want to print from first
page always.

          ' Print the page by sending EM_FORMATRANGE message
        newStartPos = SendMessage(mHwnd, EM_FORMATRANGE, True, mFormatRange)
        If newStartPos >= TextLength Then
            Exit Do
        End If
        mFormatRange.mCharRange.firstChar = newStartPos    ' Starting
position for next page
        mFormatRange.hdc = frmRTPreview.picP.hdc
        mFormatRange.hdcTarget = frmRTPreview.picP.hdc
        mpage = mpage + 1
        DoEvents
    Loop

       ' Must cleanse memory here before print, otherwise font will not be
right
    dumpaway = SendMessage(mHwnd, EM_FORMATRANGE, False, ByVal CLng(0))

    If newStartPos >= TextLength Then
        Exit Sub
    End If

       ' Have to reinitialize printer here
    Printer.Print ""
    Printer.ScaleMode = vbTwips

       ' Actual print to printer, starting from the user-selected Page No.
    mFormatRange.hdc = Printer.hdc
    mFormatRange.hdcTarget = Printer.hdc

      ' Update char range
    mFormatRange.mCharRange.firstChar = newStartPos

    Do
        newStartPos = SendMessage(mHwnd, EM_FORMATRANGE, True, mFormatRange)
        If newStartPos >= TextLength Then
            Exit Do
        End If
        If mpage >= mToPage Then
            Exit Do
        End If
        mFormatRange.mCharRange.firstChar = newStartPos
        Printer.NewPage                  ' Move on to next page
        Printer.Print ""                 ' Re-initialize hDC
        mFormatRange.hdc = Printer.hdc
        mFormatRange.hdcTarget = Printer.hdc
        mpage = mpage + 1
        DoEvents
    Loop
      ' Commit the print job
    Printer.EndDoc
      ' Free up memory
    dumpaway = SendMessage(mHwnd, EM_FORMATRANGE, False, ByVal CLng(0))
    frmRTDoc.TextHidden.Text = ""
    frmRTDoc.picHidden.Picture = LoadPicture()
End Sub

Function DocWYSIWYG(RTB As Control) As Long
     Dim LeftMargin As Long, RightMargin As Long
     Dim linewidth As Long
     Dim PrinterhDC As Long
     Dim r As Long
     Printer.ScaleMode = vbTwips
     LeftMargin = gLeftMargin * 1440
     RightMargin = Printer.Width - gRightMargin * 1440
     linewidth = RightMargin - LeftMargin
     DocWYSIWYG = linewidth
End Function

Thanks,
Tim