Hola a todos, estoy dándole vueltas y vueltas y no veo por donde meterle mano.

Lo que pretendo es distribuir un texto de forma homogénea dentro de un textbox miltiline, es decir que una vez digitado todo el texto pulsemos Enter y el contenido del mismo quede distribuido tal cual se muestra en el formulario incluido en el archivo adjunto. El Textbox tiene en este caso un límite de 30 caracteres por linea. 

Alineado Textbox.xlsm

Saludos amigo @JSDJSD, no creo que te quede perfecto, pero esto podría ayudarte

 

Sub pasarTexto()
    Dim stexto As String
    Dim sTempo As String
    Dim nCont As Integer
    
    stexto = TextBox1.Text
    
    sTempo = Mid(stexto, 1, 30)
    Do While sTempo <> ""
        If Len(Trim(stexto)) <= 30 Then
            ListBox1.AddItem ajustarTexto(Trim(sTempo), 30)
            Exit Do
        Else
            'verificamos si el siguiente caracter (el 31) o el 30
            'es un espacio, si es asi, colocamos la cadana completa
            If Mid(stexto, 31, 1) = " " Or _
                Mid(stexto, 30, 1) = " " Then
                ListBox1.AddItem ajustarTexto(Trim(sTempo), 30)
                stexto = Trim(Replace(stexto, sTempo, ""))
                'eliminamos la cadena del texto original
                sTempo = Mid(stexto, 1, 30)
            Else
                'como es una cadena completa, buscamos el espacio anterior
                nCont = InStrRev(sTempo, " ")
                'si no hay espacios, se coloca todo el texto, seria una
                'palabra de mas de 30 caracteres continuos (creo imposible)
                If nCont = 0 Then
                    ListBox1.AddItem Trim(sTempo)
                    stexto = Trim(Replace(stexto, sTempo, ""))
                    'eliminamos la cadena del texto original
                    sTempo = Mid(stexto, 1, 30)
                Else
                    sTempo = Trim(Mid(sTempo, 1, nCont))
                    ListBox1.AddItem ajustarTexto(sTempo, 30)
                    stexto = Trim(Replace(stexto, sTempo, ""))
                    'eliminamos la cadena del texto original
                    sTempo = Mid(stexto, 1, 30)
                End If
            End If
        End If
    Loop
End Sub
Function ajustarTexto(ByVal stexto As String, ByVal nLetras As Integer) As String
    Dim sTemporal As String
    Dim nEspacios As Integer
    Dim n As Integer
    Dim sSeparador As String
    
    
    sTemporal = Trim(stexto)
    ajustarTexto = sTemporal
    
    If Len(sTemporal) < nLetras Then
        nEspacios = nLetras - Len(sTemporal)

Repetir:
        sSeparador = " "
        If InStr(1, sTemporal, " ") = 0 Then sSeparador = "_"
        For n = 1 To Len(sTemporal)
            If Mid(sTemporal, n, 1) = sSeparador Then
                sTemporal = VBA.Replace(sTemporal, sSeparador, "__", Count:=1)
                nEspacios = nEspacios - 1
            End If
            If nEspacios = 0 Then Exit For
        Next n
        If nEspacios > 0 Then
            GoTo Repetir
        End If
    End If
    
    ajustarTexto = VBA.Replace(sTemporal, "_", " ")
    
End Function

 

 

Hace 58 minutos , bigpetroman dijo:

Saludos amigo @JSDJSD, no creo que te quede perfecto, pero esto podría ayudarte

Ya lo creo que puede ayudarme bigpetroman, excelente aporte.

Por ahí iba yo encaminado, pero sinceramente no fui capaz, aun me falta mucho para llegar a vuestro nivel, pero mi satisfacción personal es que cada día que pasa avanzo un poquito más, gracias. 

Tema Solucionado.

Editado el el 3 de abril5 años por JSDJSD