View Full Version : Insert a line break after word wrap
av8tordude
11-06-2019, 02:08 AM
I have a multi-line textbox I want to insert a line break after word-wraps to a new line. Can someone help with a vba code that can do this.
Thank you kindly
I posted this in another forum..
https://www.mrexcel.com/forum/excel-questions/1114278-insert-line-break-after-word-wrap.html
paulked
11-06-2019, 05:17 AM
TextBox1 = "The quick brown fox jumps over the lazy dog." & Chr(10) & "Here we go again!"
av8tordude
11-06-2019, 06:17 PM
Hi Paul,
Can you help me out with this code. I placed this code in the textbox1 change event, but when I use a command button to place the string in a cell, it still shows 1 string. I event tried putting the code in the command button, but still 1 string. It doesn't show two lines
paulked
11-06-2019, 06:28 PM
A text box is one string, no matter what breaks, carriage returns etc are in it. What exactly are you trying to do?
av8tordude
11-06-2019, 06:41 PM
If I type the below string in a textbox and the string is word-wrapped from word "lazy", I want to enter the string in a cell exactly like below. Which means, it needs a line break after the word "lazy". I can manually press shift-enter but i would like to do this automatically or place the string in the cell exactly like it is displayed in the textbox.
The quick brown fox jumps over the lazy
dog."Here we go again!"
Artik
11-06-2019, 06:44 PM
In attachment only leaven to bread. I don't know any other method than examining the text in the auxiliary field. But I do not exclude that another way exists.
Artik
paulked
11-06-2019, 06:52 PM
Private Sub CommandButton1_Click()
Sheet1.[a1] = TextBox1.Text
End Sub
Private Sub UserForm_Activate()
TextBox1 = "The quick brown fox jumps over the lazy" & Chr(10) & "dog. Here we go again!"
End Sub
That works perfectly well for me. A1 contains
The quick brown fox jumps over the lazy
dog. Here we go again!
av8tordude
11-06-2019, 06:56 PM
Artik....this is exactly what I'm looking for. I'll examine the code to fit my needs. Thank you very much
av8tordude
11-06-2019, 07:19 PM
When there is 1 line string, it errors. how can I alter the code to allow for entering string that doesn't wrap also
ReDim Preserve varResult(1 To k)
Private Sub CommandButton1_Click()
Dim varTxt1 As Variant
Dim i As Long
Dim k As Long
Dim varResult As Variant
Dim sngWdth As Single
Dim sngHght As Single
Dim lLastSpacePos As Long
Dim strTmp As String
varTxt1 = Split(Me.TextBox1.Text)
sngWdth = Me.TextBox1.Width
Me.TextBox2.Width = sngWdth
sngHght = Me.TextBox2.Height
Me.TextBox2.MultiLine = True
Do
Me.TextBox2.Value = Me.TextBox2.Value & varTxt1(i) & " "
Me.TextBox2.AutoSize = True
If Me.TextBox2.Height > sngHght Then
strTmp = Left(Me.TextBox2.Value, Len(Me.TextBox2.Value) - 1)
lLastSpacePos = InStrRev(strTmp, " ")
strTmp = Left(strTmp, lLastSpacePos - 1)
If k = 0 Then
k = k + 1
ReDim varResult(1 To 1)
Else
k = k + 1
ReDim Preserve varResult(1 To k)
End If
varResult(k) = strTmp
Me.TextBox2.Value = Mid(Me.TextBox2.Value, Len(strTmp) + 2)
End If
i = i + 1
Me.TextBox2.Width = sngWdth
Me.TextBox2.Height = sngHght
Me.TextBox2.AutoSize = False
Loop Until i > UBound(varTxt1)
If Len(Me.TextBox2.Value) > 0 Then
k = k + 1
ReDim Preserve varResult(1 To k)
varResult(k) = Trim(Me.TextBox2.Value)
Me.TextBox2.Value = vbNullString
End If
varResult = Join(varResult, vbLf)
Range("A1") = varResult
Artik
11-06-2019, 07:32 PM
Below, it is extinguishing a fire, not a decent solution :)
Change:
(...)
Loop Until i > UBound(varTxt1)
If Len(Me.TextBox2.Value) > 0 Then
If k = 0 Then
k = k + 1
ReDim varResult(1 To 1)
Else
k = k + 1
ReDim Preserve varResult(1 To k)
End If
varResult(k) = Trim(Me.TextBox2.Value)
Me.TextBox2.Value = vbNullString
End If
(...)
Artik
av8tordude
11-06-2019, 07:46 PM
One last request...If the textbox Enterkeybehavior is set to true, can you adapt the code to allow this?
Kenneth Hobs
11-06-2019, 08:28 PM
FWIW, I used Word to do it. It takes some math to make it fit in a cell just right. That can change if fonts change.
'https://www.mrexcel.com/forum/excel-questions/1022360-fitting-text-listbox.htmlSub Test_LinesToArr()
Dim s As String, a
s = "Fourscore and seven years ago our " & _
"fathers brought forth on this continent a new nation"
a = LinesToArr(s, Sheet2.tbML.Width - 40)
'MsgBox Join(a, vbLf)
Sheet2.[A1] = Join(a, vbLf)
End Sub
'https://docs.microsoft.com/en-us/office/troubleshoot/excel/determine-column-widths, 10=75 pixels
'textbox width is in points.
Function LinesToArr(s As String, dPoints As Double, _
Optional wFile As String = "")
Dim a(), strLine As String, i As Long, L As Long
'Tools > References > Microsoft Word xx.0 Object Library
Dim wdApp As Word.Application, myDoc As Word.Document
Dim wClose As Boolean
If wFile = "" Then wFile = ThisWorkbook.Path & "\LinesToArray.docm"
'Tell user what file is missing and exit.
If Dir(wFile) = "" Then
MsgBox "File does not exist." & vbLf & wFile, _
vbCritical, "Exit - Missing LinesToArray File"
End If
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
wClose = True
End If
On Error GoTo 0
'On Error GoTo errorHandler
With wdApp
.Application.DisplayAlerts = wdAlertsNone
'Open form file and associate data file
Set myDoc = wdApp.Documents.Open(wFile, Visible:=True)
With myDoc
.Content = s
With wdApp.Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0)
'9.6 = 1" in LinesToArray.docm
.RightIndent = InchesToPoints(10.6 - dPoints / 72)
End With
L = .BuiltinDocumentProperties("Number of Lines")
End With
With wdApp.Selection
.HomeKey Unit:=wdStory
Do
.EndKey Unit:=wdLine, Extend:=wdExtend
ReDim Preserve a(0 To i)
a(i) = .Text
.MoveDown Unit:=wdLine, Count:=1
.HomeKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1
i = i + 1
Loop Until i = L
End With
.Application.DisplayAlerts = wdAlertsAll
myDoc.Close False
Set myDoc = Nothing
If wClose Then Set wdApp = Nothing
End With
GoTo EndNow
errorHandler:
MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
EndNow:
'Trim trailing chars in last element if it exists.
s = a(UBound(a))
'If Right(s, 2) = vbNewLine Then a(UBound(a)) = Left(s, Len(s) - 2)
If Right(s, 1) = vbCr Then a(UBound(a)) = Left(s, Len(s) - 1)
LinesToArr = a
End Function
Might be sufficient:
Private Sub CommandButton1_Click()
x = TextBox1.Width \ 4
sn = Split(TextBox1)
For j = 0 To UBound(sn)
If Len(c01) + Len(sn(j)) > x Then
c00 = c00 & vbLf & Trim(c01)
c01 = sn(j) & " "
Else
c01 = c01 & sn(j) & " "
End If
Next
MsgBox c00 & vbLf & c01
End Sub
av8tordude
11-07-2019, 02:20 PM
Might be sufficient:
Private Sub CommandButton1_Click()
x = TextBox1.Width \ 4
sn = Split(TextBox1)
For j = 0 To UBound(sn)
If Len(c01) + Len(sn(j)) > x Then
c00 = c00 & vbLf & Trim(c01)
c01 = sn(j) & " "
Else
c01 = c01 & sn(j) & " "
End If
Next
MsgBox c00 & vbLf & c01
End Sub
This code works wonderful for me. Only 1 issue I can't seem to fix. The code adds a vbLf before the string.
example
vbLf
My dog name is vbLf
spot. he is a vbLf
boy dog.
Private Sub CommandButton1_Click()
x = TextBox1.Width \ 4
sn = Split(TextBox1)
For j = 0 To UBound(sn)
If Len(c01) + Len(sn(j)) > x Then
c00 = c00 & vbLf & Trim(c01)
c01 = sn(j) & " "
Else
c01 = c01 & sn(j) & " "
End If
Next
MsgBox mid(c00,2) & vbLf & c01
End Sub
av8tordude
11-07-2019, 06:52 PM
I would like my textbox to be flexible for the user. Can this code be suited in conjunction with the EnterKeyBehavior set to true
I see no relation between 'flexible' and 'EnterKeyBehaviot'.
Kenneth Hobs
11-08-2019, 07:56 PM
You will have to explain what flexible means to you. Code is all about logic so if we don't know the rules, it can not be "flexible".
If EnterKeyBehavior is set, so what? Ctrl+Enter key will enter a new line no matter what that is set to if multiline property is true.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.