finding where text wraps in a textbox

[Russ]

I have text inputted in a textbox on a form. The text wraps in the textbox.
Code then places the text string from the textbox into a cell on a worksheet.
I turn off wrap text in the cell to keep the row height from changing (the
text never gets looked at in the cell). Other code takes the text string
from the cell and displays it a list box (which I find does not have the
ability to deal with text wrapping). If I make the user use alt-enter to
enter multiline text in the original textbox I can with code find the line
feeds (chr(10)) and put the text string in multiple lines in the listbox. Is
there a way to accomplish all this without requiring alt-enter when typing
text into the textbox. Or another way to say this is there a way to find
where text wraps in a textbox when alt-enter is not used.

 

[Jeff]

The simplest way set the maximum Number of characters in the text box.

Textbox1.MaxLength = 10

 

[Russ]

Maybe I was not clear. I want to let the text wrap and do not want to limit
the amount of text although it will never be more than say a 1000 characters.
I am looking for a way to find out where the text wraps so that i can
reproduce it in a multi line listbox.

 

[Peter T]

That's not straightforward at all. There are various approaches, here's
one -

Add two textboxes to a form. Click on the form to dump the sample text, then
write or paste your long text into textbox1 and click the form again. You
won't need to dump text for your purposes as all is in the array "arrLines"

Option Explicit

Private Sub UserForm_Initialize()

With Me.TextBox1
.Left = 3
.Top = 3
.Width = 96
.Height = 240
End With

Me.Height = 270
Me.TextBox2.Left = Me.Width + 50 ' hide the helper textbox
Me.Caption = "enter long text and click form"

MakeText

End Sub

Private Sub UserForm_Click()
Dim arrLines() As String

TextToArray Me.TextBox1, arrLines
LinesToCells arrLines()

End Sub

Sub MakeText()
Dim i As Long, j As Long
Dim sChar As String, sText As String
For i = 65 To 75
sChar = ""
For j = 1 To 7
sChar = sChar & Chr(i)

sText = sText & sChar & " "
Next
Next

Me.TextBox1.Text = sText
End Sub

Sub TextToArray(tbx As msforms.TextBox, arrLines() As String)
Dim sText As String
Dim i As Long, cnt As Long, idx As Long
Dim arr

ReDim arrLines(1 To 400)
arr = Split(tbx.Text, " ")

With Me.TextBox2

With .Font
.Name = tbx.Font.Name
.Size = tbx.Font.Size
.Bold = tbx.Font.Bold
' other properties must be same
End With

.AutoSize = True '< important or at design time

For i = 0 To UBound(arr)

.Text = sText & arr(i)

If .Width > tbx.Width Then
idx = idx + 1
arrLines(idx) = sText
.Text = ""
sText = arr(i) & " "
Else
sText = .Text & " "
End If

Next

If Len(.Text) Then
idx = idx + 1
arrLines(idx) = .Text
End If

End With

ReDim Preserve arrLines(1 To idx)

End Sub

Sub LinesToCells(arrLines() As String)

Range("a1:a400").Clear

With Range("a1").Resize(UBound(arrLines), 1)
.Value = Application.Transpose(arrLines)
End With

Cells(UBound(arrLines) + 2, 1) = Me.TextBox1.Text

End Sub

You might want to remove (with Replace) non printing characters such as line
breaks, tabs etc before making the array of lines.

Regards,
Peter T

 

[Russ]

Peter,
I was able to take your clever code and modify it to accomplish exactly what
I needed. I was not aware of the autosize property of textboxes.
Many thanks.