Saludos listeros.

Después de comentarlo particularmente con Jorge Serrano, de la News de
Visual Basic de IberNet, os remito dos funciones :

MemoLinesSinCRLF( sTexto as string ) as collection,
que recibe un texto largo, con retornos de carro y devuelve una colección
con las líneas que contiene ese texto.

MemoLines( sTexto as string , sngLongitud as single , iLinea as integer ,
oObject as variant , bLineasEnBlanco as boolean ) as Variant.
Función que recibe un texto y lo divide en líneas de sngLongitud, en
milímetros. Puede devolver una colección de líneas de la longitud
especificada o bien, si así se indica mediante iLinea, una línea en
concreto de toda la colección.
oObject puede ser el objeto printer, un Form o bien un PictureBox, de
manera que podemos calcular la anchura de las líneas para pantalla o
impresora.
bLineasEnBlanco define si deseamos que se nos retornen y/o cuenten las
líneas totalmente en blanco o no.

No son nada del otro mundo pero quizá os puedan ayudar en algo.
Si las utilizais y encontrais algún 'bug' o comentario digno de mención,
hacédmelo saber para poder mejorarlas.

Saludos.
ORZO, <orzo@orzo.com>



Attribute VB_Name = "Memos"
'
' Memos
' Módulo para la división de textos largos en líneas.
' Fecha : 7/12/97
' De Francisco Javier Rodríguez Arévalo para ORZO, S.C.P. (c) 1997
' Uso y distribución gratuitos
'

' Variables declaradas explícitamente.
Option Explicit

' Constantes de Retorno para MemoLines.
Const MEMO_TODAS = -1

Public Function MemoLines(ByVal sTexto As String, ByVal sngLongitud As Single, Optional ByVal iLineaARetornar As Variant, Optional ByVal oObject As Variant, Optional ByVal bLineasEnBlanco As Variant) As Variant
  ' Retorna una línea en concreto contenida en el texto pasado, según una
  ' longitud dada, en un objeto concreto. La escala viene dada por el
  ' propio objeto. Los objetos pueden ser del tipo Form, PictureBox o
  ' Printer

  Dim oLineasSinCRLF As New Collection ' Colección que representa el texto
                                        ' sin retornos de carro.
  Dim oLineasSinSPACES As New Collection ' El texto dividido en líneas
                                          ' ajustadas al tamaño especificado.
  Dim sLineTmp As String

  ' Por omisión, se retornarán todas las líneas.
  If (IsMissing(iLineaARetornar)) Then
    iLineaARetornar = MEMO_TODAS
  End If
  ' Por omisión, el objeto es la impresora.
  If (IsMissing(oObject)) Then
    Set oObject = Printer
  End If
  ' Por omisión, Se devuelven las líneas en blanco, también.
  If (IsMissing(bLineasEnBlanco)) Then
    bLineasEnBlanco = True
  End If

  Dim iSPACE As Integer ' Posición de un nuevo espacio.
  Dim iPosAnterior As Integer ' Guarda la última posición válida.
  Dim iContador As Integer ' Para recorrer la colección de líneas.
  Dim bForzar As Boolean ' En condiciones especiales, fuerza la
                            ' asignación de la línea y el fin del bucle.

  ' Sea cual sea el objeto, las medidas siempre se entenderán en milímetros.
  oObject.ScaleMode = vbMillimeters

  ' Quita los espacios inútiles.
  sTexto = Trim$(sTexto)
  ' Si hay texto y se ha especificado una longitud mínima para el texto de
  ' retorno ...
  If ((Len(sTexto) <> 0) And (sngLongitud > 0)) Then
    ' Se extraen los retornos de carro del texto original, de manera que
    ' nos quede una colección de líneas puras.
    Set oLineasSinCRLF = MemoLinesSinCRLF(sTexto)
    ' Recorreremos todas las líneas, una a una.
    For iContador = 1 To oLineasSinCRLF.Count
      ' Toma la línea que toca.
      sLineTmp = oLineasSinCRLF(iContador)
      ' Si la línea tiene longitud 0 ...
      If (Len(sLineTmp) = 0) Then
        ' ... es que es una línea en blanco.
        If (bLineasEnBlanco) Then
          ' y se añade a la colección de retorno sólo si así se ha
          ' indicado.
          oLineasSinSPACES.Add Key:=CStr(oLineasSinSPACES.Count + 1), Item:=""
        End If
      Else
        ' Iniciamos el bucle de fragmentación.
        iPosAnterior = 0
        Do While (Len(sLineTmp) <> 0)
          ' Busca el primer espacio en la cadena ...
          iSPACE = InStr(iPosAnterior + 1, sLineTmp, Chr$(32))
          ' Determina si la nueva posición es válida.
          If (iSPACE = 0) Then
            ' Se ha alcanzado un final de línea sin espacio.
            If (oObject.TextWidth(sLineTmp) > sngLongitud) Then
              ' La longitud de la línea excede el máximo permitido.
              ' Se divide en dos nuevas líneas.
              oLineasSinSPACES.Add Key:=CStr(oLineasSinSPACES.Count + 1), Item:=Trim$(Left$(sLineTmp, iPosAnterior))
              oLineasSinSPACES.Add Key:=CStr(oLineasSinSPACES.Count + 1), Item:=Trim$(Mid$(sLineTmp, iPosAnterior + 1))
            Else
              ' La longitud de la línea es válida.
              oLineasSinSPACES.Add Key:=CStr(oLineasSinSPACES.Count + 1), Item:=sLineTmp
            End If
            sLineTmp = ""
          Else
            ' Hay un espacio.
            If ((oObject.TextWidth(Trim$(Left$(sLineTmp, iSPACE))) > sngLongitud)) Then
              ' La posición actual queda fuera del margen de impresión permitido.
              ' Guarda la línea hasta la siguiente posición válida.
              oLineasSinSPACES.Add Key:=CStr(oLineasSinSPACES.Count + 1), Item:=Trim$(Left$(sLineTmp, iPosAnterior))
              sLineTmp = Trim$(Mid$(sLineTmp, iPosAnterior + 1))
              iPosAnterior = 0
            Else
              ' Movemos el puntero sobre la cadena ...
              iPosAnterior = iSPACE
            End If
          End If
        Loop
      End If
    Next iContador
  End If

  If (iLineaARetornar = MEMO_TODAS) Then
    ' Si no se ha especificado ninguna línea en concreto, asigna la
    ' colección completa de líneas extraídas para su retorno.
    Set MemoLines = oLineasSinSPACES
  Else
    ' Asigna la línea en concreto para su retorno.
    MemoLines = oLineasSinSPACES(iLineaARetornar)
  End If
End Function

Public Function MemoLinesSinCRLF(ByVal sTexto As String) As Collection
  ' Devuelve una colección de cadenas que corresponden a las líneas
  ' contenidas en el Texto pasado como parámetro.
  Dim iCRLF As Integer ' Nuevo CRLF localizado.
  Dim oLineas As New Collection ' Colección de líneas a devolver.
  ' Eliminamos los posibles espacios sobrantes.
  sTexto = Trim$(sTexto)
  ' Vamos a recorrer todo el texto ...
  Do While (Len(sTexto) <> 0)
    ' Busca el primer retorno de carro en la cadena.
    iCRLF = InStr(1, sTexto, vbCrLf)
    If (iCRLF = 0) Then
      ' Si no lo encuentra el texto pasa a ser la última línea de la
      ' colección.
      oLineas.Add Key:=CStr(oLineas.Count + 1), Item:=Trim$(sTexto)
      sTexto = ""
    Else
      oLineas.Add Key:=CStr(oLineas.Count + 1), Item:=Trim$(Left$(sTexto, iCRLF - 1))
      sTexto = Mid$(sTexto, iCRLF + 2)
    End If
  Loop
  ' Retornamos las líneas en forma de colección, sin retornos de carro.
  Set MemoLinesSinCRLF = oLineas
End Function