Breaking up text keep existing linebreaks
RB Smissaert
- The existing linebreaks need to be preserved.
- There is a maximum line length, so from one linebreak to the next.
- Breaks need to happen at spaces if it can't be at a line break.
- Optionally there is a maximum length for the returned string.
I am sure there must be a simple and elegant solution for this, but have
been
messing for a long time now and still can't get it right.
Hopefully somebody has done this already and is willing to pass it on.
This is what I have sofar, but it is no good:
Function BreakupText(strString As String, _
lMaxLineChars As Long, _
Optional lMaxTotalChars As Long = -1) As String
Dim lBreakPos As Long
Dim lPos1 As Long
Dim lPos2 As Long
10 On Error GoTo ERROROUT
20 If Len(strString) <= lMaxLineChars Then
30 BreakupText = strString
40 Exit Function
50 End If
60 If lMaxTotalChars > -1 Then
70 If Len(strString) > lMaxTotalChars Then
80 strString = Left$(strString, lMaxTotalChars)
90 End If
100 End If
110 Do While lPos2 < Len(strString)
120 If Len(strString) - lBreakPos < lMaxLineChars Then
'so we can add the whole remaining string
'----------------------------------------
130 lPos2 = Len(strString)
140 Else
150 lPos2 = InStr(lPos1 + 1, strString, vbCrLf, vbBinaryCompare)
160 End If
170 If lPos2 - lBreakPos < lMaxLineChars And lPos2 > 0 Then
'whole line less than max line, so add
'-------------------------------------
180 BreakupText = BreakupText & _
Mid$(strString, lBreakPos + 1, (lPos2 - lBreakPos)
+ 1)
190 lBreakPos = lPos2 + 1
200 lPos1 = lPos2
210 Else
220 lPos2 = InStr(lPos1 + 1, strString, Chr(32), vbBinaryCompare)
230 If lPos2 - lBreakPos < lMaxLineChars And lPos2 > 0 Then
'next word can be added to line
'------------------------------
240 BreakupText = BreakupText & _
Mid$(strString, lPos1 + 1, (lPos2 - lPos1) - 1)
250 lPos1 = lPos2
260 Else
270 If lPos2 > 0 Then
'add next word on a new line
'---------------------------
280 BreakupText = BreakupText & vbCrLf & _
Mid$(strString, lBreakPos + 1, (lPos2 -
lBreakPos) + 1)
290 lBreakPos = lPos2 + 1
300 lPos1 = lPos2
310 Else
'no word to add, so add max number of chars
'------------------------------------------
320 lPos2 = lBreakPos + lMaxLineChars
330 BreakupText = BreakupText & vbCrLf & _
Mid$(strString, lBreakPos + 1, (lPos2 -
lBreakPos) + 1)
340 lBreakPos = lPos2
350 End If
360 End If
370 End If
380 Loop
390 Exit Function
ERROROUT:
400 MsgBox Err.Description & _
vbCrLf & vbCrLf & _
"Error number: " & Err.Number, , _
"error at line: " & Erl
End Function
Thanks for any assistance.
RBS
Rick Rothstein (MVP - VB)
HiddenTextBox, set its Visible property to False, set its BorderStyle to
0-None, set its MultiLine property to True and set its Font property to
"Courier New" (I'll explain this one in a minute). Now, copy/paste the code
below my signature into the form's code window. You can now set up the rest
of the project anyway you want and simply pass whatever text you want into
the BreakupText function and the return text will be what you are looking
for. One thing about the font, though. In order for setting maximum line
length in characters to make any sense, your font will have to be a
non-proportional one. That is why I set the hidden TextBox's Font property
to "Courier New"; because this font is a fixed width font. Anyway, give this
a try and see if it does what you want.
Rick
Private Declare Function SendMessageLong Lib _
"User32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Const EM_FMTLINES = &HC8
Const EM_LINEFROMCHAR = &HC9
Function BreakupText(strString As String, _
lMaxLineChars As Long, _
Optional lMaxTotalChars As Long = -1) As String
Dim LetterWidth As Long
With HiddenTextBox
Set Me.Font = .Font
LetterWidth = Me.TextWidth("X")
.Width = lMaxLineChars * LetterWidth
.Text = strString
SendMessageLong .hwnd, EM_FMTLINES, 1#, 0#
BreakupText = Replace$(.Text, vbCr & vbCrLf, vbNewLine)
SendMessageLong .hwnd, EM_FMTLINES, 0#, 0#
End With
If lMaxTotalChars > -1 Then
BreakupText = Left$(BreakupText, lMaxTotalChars)
If Right$(BreakupText, 1) = vbCr Then
BreakupText = Left$(BreakupText, Len(BreakupText) - 1)
End If
End If
End Function
Mike Williams
news:eavWUHa7...@TK2MSFTNGP02.phx.gbl...
> Trying to put together a function that breaks up an existing
> string, where:
> - The existing linebreaks need to be preserved.
> - There is a maximum line length, so from one linebreak to the next.
> - Breaks need to happen at spaces if it can't be at a line break.
> - Optionally there is a maximum length for the returned string.
I'm not entirely sure what you are trying to do, but it looks as though you
want to break up the text into lines of a specified maximum character length
(rather than a maximum text width) and that you want the resultant string to
contain vbCrLf at the break points? If so then try the following. Drop a
standard Text Box and a Command Button onto a Form and in the IDE set the
TextBox Borderstyle to None, its MultiLine property to True and its Visible
property to False. Then paste in the following code. Is this what you're
after, or have I misunderstood your question?
Mike
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg _
As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETLINE = &HC4
Private Function BreakText _
(s1 As String, nChars As Long) As String
Dim nLines As Long, usedLines As Long
Dim nLength As Long, n As Long
Dim sBuffer As String * 100, sInitial As String * 2
Dim LineArray() As String
Me.Font.Name = "Courier New"
Set Text1.Font = Me.Font
Text1.Width = Me.TextWidth(Space$(nChars)) + _
TextWidth("x") / 2
Text1.Text = s1
sInitial = Chr$(100 - 1) & Chr(0)
nLines = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, 0)
For n = 1 To nLines
Mid(sBuffer, 1, 2) = sInitial
nLength = SendMessage(Text1.hwnd, EM_GETLINE, _
n - 1, ByVal sBuffer)
BreakText = BreakText & _
Trim(Left(sBuffer, nLength)) & vbCrLf
Next n
End Function
Private Sub Command1_Click()
Dim sTest As String
sTest = "This is just some text to check the operation "
sTest = sTest & "of the code to break it into lines."
Print BreakText(sTest, 12)
End Sub
RB Smissaert
same
without using a textbox. Will post back when I have found it.
RBS
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:eavWUHa7...@TK2MSFTNGP02.phx.gbl...
RB Smissaert
textbox:
Sub BreakupText(strString As String, _
lMaxLineChars As Long, _
Optional lMaxTotalChars As Long = -1)
Dim i As Long
Dim n As Long
Dim x As Long
Dim lPreviousSpace As Long
Dim lPreviousBreak As Long
Dim lLen As Long
lLen = Len(strString)
If lLen < lMaxLineChars Then
Exit Sub
End If
'deal with total string length
'-----------------------------
If lMaxTotalChars > -1 Then
If lLen > lMaxTotalChars Then
lPreviousBreak = InStrRev(strString, Chr(13), lLen, vbBinaryCompare)
lPreviousSpace = InStrRev(strString, Chr(32), lLen, vbBinaryCompare)
If lPreviousSpace > lPreviousBreak Then
strString = Left$(strString, lPreviousSpace - 1)
Else
If lPreviousBreak = 0 Then
strString = Left$(strString, lMaxTotalChars)
Else
strString = Left$(strString, lPreviousBreak - 1)
End If
End If
End If
End If
'deal with string without linebreaks or spaces
'---------------------------------------------
If InStr(1, strString, Chr(32)) = 0 And _
InStr(1, strString, vbCrLf, vbBinaryCompare) = 0 Then
For i = 1 To lLen
If x = 0 Then
If i Mod lMaxLineChars = 0 And i >= lMaxLineChars Then
x = x + 1
strString = Left$(strString, i) & _
vbCrLf & _
Mid$(strString, i + 1)
lLen = lLen + 2 'is this OK?
End If
Else
If i Mod lMaxLineChars + 2 = 0 And i >= lMaxLineChars Then
x = x + 1
strString = Left$(strString, i) & _
vbCrLf & _
Mid$(strString, i + 1)
lLen = lLen + 2 'is this OK?
End If
End If
Next i
Exit Sub
End If
For i = 1 To lLen
If Mid$(strString, i, 2) = vbCrLf Then
n = 0
Else
n = n + 1
End If
'deal with line length
'---------------------
If n > lMaxLineChars Then
lPreviousSpace = InStrRev(strString, Chr(32), i, vbBinaryCompare)
If i - lPreviousSpace < lMaxLineChars Then
ReplaceCharInString strString, lPreviousSpace, vbCrLf
lLen = lLen + 1 'is this OK?
Else
strString = Left$(strString, i - lMaxLineChars) & _
vbCrLf & _
Mid$(strString, (i - lMaxLineChars) + 1)
lLen = lLen + 2 'is this OK?
End If
n = 0
End If
Next i
End Sub
Sub ReplaceCharInString(vString As Variant, lPos As Long, strReplace As
String)
If lPos = 1 Then
vString = strReplace & Right$(vString, Len(vString) - 1)
Else
If lPos = Len(vString) Then
vString = Left$(vString, Len(vString) - 1) & strReplace
Else
vString = Left$(vString, lPos - 1) & _
strReplace & _
Right$(vString, Len(vString) - lPos)
End If
End If
End Sub
RBS
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:eavWUHa7...@TK2MSFTNGP02.phx.gbl...
Robert Morley
60-100) down to the bottom of the function, just so that the vbCrLfs don't
add a few extra characters you weren't expecting. Alternatively, you can do
it twice...the first time being so that your function doesn't process much
more data than it needs to, and the second time being the final overall
length check.
Next, in line 170, try adding parentheses around your conditions. It's
entirely possible that you've got the order of operations correct there, but
I try never to rely on a language's OOO, as it varies from one language to
another (and at least for myself, I can never remember which language uses
what order). Thus:
170 If ((lPos2 - lBreakPos) < lMaxLineChars) And (lPos2 > 0) Then
For your word breaks, try using InstrRev to search backwards, rather than
going forwards word-by-word.
Finally, I'd suggest breaking this into two functions, as it might make
handling it easier. The outside function would be what you've got now, and
the inside function would be a "Split this line" function, which would take
a line in and a maximum line length and spit out the correct line/lines.
Ah, what the hell, let me see if I can code this...let me know if this does
what you want. Note that the max total length is set to &H3FFFFFFF because
unbeknowst to me until just this momstn, that's the highest size Left$() can
handle (at least in VBA, where I was testing this).
Option Explicit
Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength As
Long, Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
varLines = Split(strText, vbCrLf)
If UBound(varLines) > LBound(varLines) Then
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & SplitThisLine(varLines(i),
lngMaxLineLength)
Next
strNewText = Mid$(strNewText, 3)
Else
strNewText = strText
End If
SplitText = Left$(strNewText, lngMaxTotalLength)
End Function
Public Function SplitThisLine(ByVal strLine As String, ByVal lngMaxLength As
Long)
Dim strNewLine As String
Dim lPos As Long
strNewLine = vbNullString
Do While Len(strLine) > lngMaxLength
lPos = InStrRev(strLine, " ", lngMaxLength)
If lPos > 0 Then
strNewLine = strNewLine & Left$(strLine, lPos) & vbCrLf
strLine = Mid$(strLine, lPos + 1)
Else
strNewLine = strNewLine & Left$(strLine, lngMaxLength) & vbCrLf
strLine = Mid$(strLine, lngMaxLength)
End If
Loop
If strNewLine <> vbNullString Then
SplitThisLine = strNewLine & strLine
Else
SplitThisLine = strLine
End If
End Function
Rob
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:eavWUHa7...@TK2MSFTNGP02.phx.gbl...
RB Smissaert
Only thing for now I can see that is wrong is that it doesn't handle a
string with
no linebreaks or spaces, but that is simple to add.
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:eoG4KZc7...@TK2MSFTNGP04.phx.gbl...
Robert Morley
below. One line fixed in each routine.
Option Explicit
Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength As
Long, Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
varLines = Split(strText, vbCrLf)
If UBound(varLines) > LBound(varLines) Then
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & SplitThisLine(varLines(i),
lngMaxLineLength)
Next
strNewText = Mid$(strNewText, 3)
Else
strNewText = SplitThisLine(strText, lngMaxLineLength)
End If
SplitText = Left$(strNewText, lngMaxTotalLength)
End Function
Public Function SplitThisLine(ByVal strLine As String, ByVal lngMaxLength As
Long)
Dim strNewLine As String
Dim lPos As Long
strNewLine = vbNullString
Do While Len(strLine) > lngMaxLength
lPos = InStrRev(strLine, " ", lngMaxLength)
If lPos > 0 Then
strNewLine = strNewLine & Left$(strLine, lPos) & vbCrLf
strLine = Mid$(strLine, lPos + 1)
Else
strNewLine = strNewLine & Left$(strLine, lngMaxLength) & vbCrLf
strLine = Mid$(strLine, lngMaxLength + 1)
End If
Loop
If strNewLine <> vbNullString Then
SplitThisLine = strNewLine & strLine
Else
SplitThisLine = strLine
End If
End Function
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:%23qoI%23Cf7H...@TK2MSFTNGP04.phx.gbl...
RB Smissaert
Function SplitText(ByVal strText As String, _
ByVal lngMaxLineLength As Long, _
Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
varLines = Split(strText, vbCrLf)
If UBound(varLines) > LBound(varLines) Then
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & _
SplitThisLine(varLines(i), lngMaxLineLength)
Next
strNewText = Mid$(strNewText, 3)
Else
strNewText = SplitThisLine(strText, lngMaxLineLength) '*** altered this
End If
SplitText = Left$(strNewText, lngMaxTotalLength)
End Function
RBS
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:%23qoI%23Cf7H...@TK2MSFTNGP04.phx.gbl...
Robert Morley
function. See the revised code I just posted.
Rob
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:e6XUMPf7...@TK2MSFTNGP05.phx.gbl...
Robert Morley
and just include the If portion of the code on its own. As is, it still
works just fine, but the only real function of the Else is to save a tiny
bit of time in the event that there are no vbCrLfs in the string.
Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength As
Long, Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
varLines = Split(strText, vbCrLf)
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & SplitThisLine(varLines(i),
lngMaxLineLength)
Next
SplitText = Left$(Mid$(strNewText, 3), lngMaxTotalLength)
End Function
Rob
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:e6XUMPf7...@TK2MSFTNGP05.phx.gbl...
Mike Williams
> Thanks, that is a nice one, but I am sure there must be a way
> to achieve the same without using a textbox.
Of course there is, but you never asked for that.
Mike
Rick Rothstein (MVP - VB)
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:ObIK3Xf7...@TK2MSFTNGP06.phx.gbl...
>I just realized that you can actually get rid of the If/Then/Else entirely
>and just include the If portion of the code on its own. As is, it still
>works just fine, but the only real function of the Else is to save a tiny
>bit of time in the event that there are no vbCrLfs in the string.
>
>
> Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength
> As Long, Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
> Dim varLines As Variant
> Dim strNewText As String
> Dim i As Long
>
> strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
You may want to reconsider the above line (and move it truncation to the end
of the routine). If you truncate the text when it comes in, then the final
text **might** be too long if any lines were physically split in your
SplitThisLine function. This depends on how RBS wants to count characters.
VB's Len function counts each vbCrLf as 2 characters. So, if you use the Len
function to check the final length of code that was truncated, it will
report too long because each line split your SplitThisLine function
introduces adds 2 additional characters for the Len function to count. Of
course, if RBS does not want to count them... fine, then your code is OK up
to this point.
One other thing you may want to consider. The application of the Left
function to truncate the text down to the specified maximum text length just
might split a vbCrLf character pair down the middle. This would leave the
file with a vbCr at the end of the text with no vbLf following it. You can
see this possibility with this simple code snippet...
T = "one" & vbCrLf & "two"
T = Left$(T, 4)
Print Asc(Mid$(T, Len(T)))
The last character in the truncated text has an ASCII value of 13 which is a
vbCr. I'm not sure, but leaving the text with that character at the end
might screw up some future concatentation that might be applied to this text
in the future... some displayers (Notepad I think) will treat a vbCr just
like it was a vbCrLf. In the code I posted earlier, I tested for this
possibility and, if the text was left with a vbCr at the end, I removed it.
Just something for you to think about.
Rick
bart.sm...@gmail.com
One situation I will have to handle is for example this:
string to split: "0123456789"
Max Line length: 5
This should come out as:
"01234" & vbcrlf
"56789"
So line length should be the visual length, not the actual count
of characters as in the above example that is 7 in the first line.
Will look at this later (at work now) and post back.
RBS
On 3 Sep, 07:41, "Robert Morley" <rmor...@magma.ca.N0.Freak1n.sparn>
wrote:
> I just realized that you can actually get rid of the If/Then/Else entirely
> and just include the If portion of the code on its own. As is, it still
> works just fine, but the only real function of the Else is to save a tiny
> bit of time in the event that there are no vbCrLfs in the string.
>
> Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength As
> Long, Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
> Dim varLines As Variant
> Dim strNewText As String
> Dim i As Long
>
> strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
> varLines = Split(strText, vbCrLf)
> strNewText = vbNullString
> For i = LBound(varLines) To UBound(varLines)
> strNewText = strNewText & vbCrLf & SplitThisLine(varLines(i),
> lngMaxLineLength)
> Next
> SplitText = Left$(Mid$(strNewText, 3), lngMaxTotalLength)
> End Function
>
> Rob
>
> "RB Smissaert" <bartsmissa...@blueyonder.co.uk> wrote in message
>
> news:e6XUMPf7...@TK2MSFTNGP05.phx.gbl...
>
> > It looks this little alteration makes it work:
>
> > Function SplitText(ByVal strText As String, _
> > ByVal lngMaxLineLength As Long, _
> > Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
>
> > Dim varLines As Variant
> > Dim strNewText As String
> > Dim i As Long
>
> > strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
>
> > varLines = Split(strText, vbCrLf)
>
> > If UBound(varLines) > LBound(varLines) Then
> > strNewText = vbNullString
> > For i = LBound(varLines) To UBound(varLines)
> > strNewText = strNewText & vbCrLf & _
> > SplitThisLine(varLines(i), lngMaxLineLength)
> > Next
> > strNewText = Mid$(strNewText, 3)
> > Else
> > strNewText = SplitThisLine(strText, lngMaxLineLength) '*** altered this
> > End If
>
> > SplitText = Left$(strNewText, lngMaxTotalLength)
>
> > End Function
>
> > RBS
>
> > "RB Smissaert" <bartsmissa...@blueyonder.co.uk> wrote in message
> >news:%23qoI%23Cf7H...@TK2MSFTNGP04.phx.gbl...
> >> Yes, that looks better and thanks for that.
> >> Only thing for now I can see that is wrong is that it doesn't handle a
> >> string with
> >> no linebreaks or spaces, but that is simple to add.
>
> >> RBS
>
> >> "Robert Morley" <rmor...@magma.ca.N0.Freak1n.sparn> wrote in message
> >>> "RB Smissaert" <bartsmissa...@blueyonder.co.uk> wrote in message
bart.sm...@gmail.com
Very good point and will have a look at that.
RBS
On 3 Sep, 08:33, "Rick Rothstein \(MVP - VB\)"
<rickNOSPAMn...@NOSPAMcomcast.net> wrote:
> See my single inline comment...
>
> "Robert Morley" <rmor...@magma.ca.N0.Freak1n.sparn> wrote in message
> > "RB Smissaert" <bartsmissa...@blueyonder.co.uk> wrote in message
> >news:e6XUMPf7...@TK2MSFTNGP05.phx.gbl...
> >> It looks this little alteration makes it work:
>
> >> Function SplitText(ByVal strText As String, _
> >> ByVal lngMaxLineLength As Long, _
> >> Optional ByVal lngMaxTotalLength As Long = &H3FFFFFFF)
>
> >> Dim varLines As Variant
> >> Dim strNewText As String
> >> Dim i As Long
>
> >> strText = Left$(strText, lngMaxTotalLength) 'Reduce workload
>
> >> varLines = Split(strText, vbCrLf)
>
> >> If UBound(varLines) > LBound(varLines) Then
> >> strNewText = vbNullString
> >> For i = LBound(varLines) To UBound(varLines)
> >> strNewText = strNewText & vbCrLf & _
> >> SplitThisLine(varLines(i), lngMaxLineLength)
> >> Next
> >> strNewText = Mid$(strNewText, 3)
> >> Else
> >> strNewText = SplitThisLine(strText, lngMaxLineLength) '*** altered
> >> this
> >> End If
>
> >> SplitText = Left$(strNewText, lngMaxTotalLength)
>
> >> End Function
>
> >> RBS
>
> >> "RB Smissaert" <bartsmissa...@blueyonder.co.uk> wrote in message
> >>news:%23qoI%23Cf7H...@TK2MSFTNGP04.phx.gbl...
> >>> Yes, that looks better and thanks for that.
> >>> Only thing for now I can see that is wrong is that it doesn't handle a
> >>> string with
> >>> no linebreaks or spaces, but that is simple to add.
>
> >>> RBS
>
> >>> "Robert Morley" <rmor...@magma.ca.N0.Freak1n.sparn> wrote in message
> >>>> "RB Smissaert" <bartsmissa...@blueyonder.co.uk> wrote in message
> ...
>
> read more »
RB Smissaert
Function SplitText(ByVal strText As String, _
ByVal lngMaxLineLength As Long, _
Optional ByVal lngMaxTotalLength As Long = 120) As String
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
'no need to do anything so get out early
If Len(strText) <= lngMaxLineLength Then
SplitText = strText
Exit Function
End If
'Reduce workload
If Mid$(strText, lngMaxLineLength, 2) = vbCrLf Then
'avoid splitting a vbCrLf
strText = Left$(strText, lngMaxTotalLength + 1)
Else
strText = Left$(strText, lngMaxTotalLength)
End If
varLines = Split(strText, vbCrLf)
strNewText = vbNullString
For i = 0 To UBound(varLines)
strNewText = strNewText & _
vbCrLf & _
SplitThisLine(varLines(i), lngMaxLineLength)
Next
SplitText = Left$(Mid$(strNewText, 3), lngMaxTotalLength + 2)
End Function
Function SplitThisLine(ByVal strLine As String, _
ByVal lngMaxLength As Long)
Dim strNewLine As String
Dim lPos As Long
strNewLine = vbNullString
Do While Len(strLine) > lngMaxLength
lPos = InStrRev(strLine, " ", lngMaxLength)
If lPos > 0 Then
strNewLine = strNewLine & Left$(strLine, lPos) & vbCrLf
strLine = Mid$(strLine, lPos + 1)
Else
strNewLine = strNewLine & Left$(strLine, lngMaxLength) & vbCrLf
strLine = Mid$(strLine, lngMaxLength + 1)
End If
Loop
If strNewLine <> vbNullString Then
SplitThisLine = strNewLine & strLine
Else
SplitThisLine = strLine
End If
End Function
Thanks again for the trouble.
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:%23LznXOf...@TK2MSFTNGP06.phx.gbl...
Robert Morley
>
> You may want to reconsider the above line (and move it truncation to the
> end of the routine). If you truncate the text when it comes in, then the
> final text **might** be too long if any lines were physically split in
> your SplitThisLine function.
Look closer, Rick. The code exists at both ends of the routine. The final
"SplitText =" assignment also truncates it to lngMaxTotalLength.
> This depends on how RBS wants to count characters. VB's Len function
> counts each vbCrLf as 2 characters. So, if you use the Len function to
> check the final length of code that was truncated, it will report too long
> because each line split your SplitThisLine function introduces adds 2
> additional characters for the Len function to count. Of course, if RBS
> does not want to count them... fine, then your code is OK up to this
> point.
He didn't ask for that, so I didn't include it, but that would be fairly
easy to implement if required...even easier if he only wants it to count as
one character. (Add vbCr's, truncate length, then do a replace of vbCr with
vbCrLf.)
> One other thing you may want to consider. The application of the Left
> function to truncate the text down to the specified maximum text length
> just might split a vbCrLf character pair down the middle. This would leave
> the file with a vbCr at the end of the text with no vbLf following it. You
> can see this possibility with this simple code snippet...
>
> T = "one" & vbCrLf & "two"
> T = Left$(T, 4)
> Print Asc(Mid$(T, Len(T)))
The code going into SplitThisLine will NEVER have vbCrLfs in it, because
that's already handled by SplitText. Thus, the split cannot happen in the
middle of a vbCrLf.
<Remainder of quoted text truncated, cuz holy crap was this getting long>
Rob
Robert Morley
meant "per line", but you meant the whole thing. I get that now and will
address in my response to RBS.
Rob
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:u8P52uk7...@TK2MSFTNGP04.phx.gbl...
Robert Morley
> If Mid$(strText, lngMaxLineLength, 2) = vbCrLf Then
> 'avoid splitting a vbCrLf
> strText = Left$(strText, lngMaxTotalLength + 1)
> Else
> strText = Left$(strText, lngMaxTotalLength)
> End If
You should have used (lngMaxTotalLength - 1) in the first line of this code,
actually, not lngMaxLineLength (note the change in variable name AND the
addition of the "- 1"). And don't forget to do the same check at the end.
strNewText = Mid$(strNewText, 3)
If Mid$(strNewText, lngMaxTotalLength - 1, 2) = vbCrLf Then
SplitText = Left$(Mid$(strNewText, 3), lngMaxTotalLength)
Else
SplitText = Left$(Mid$(strNewText, 3), lngMaxTotalLength + 1)
End If
Oh, and one other thing: the above code (both yours and mine) will fail if
the user overrides lngMaxTotalLength with &H3FFFFFFF (or higher), though I
doubt that that's really a huge concern, since I noticed you set the default
to be 120, implying that that parameter will generally be a comparatively
small number.
> lPos = InStrRev(strLine, " ", lngMaxLength)
> If lPos > 0 Then
> strNewLine = strNewLine & Left$(strLine, lPos) & vbCrLf
> strLine = Mid$(strLine, lPos + 1)
> Else
> strNewLine = strNewLine & Left$(strLine, lngMaxLength) & vbCrLf
> strLine = Mid$(strLine, lngMaxLength + 1)
> End If
An additional optimization that I realized for this one would be:
> lPos = InStrRev(strLine, " ", lngMaxLength)
> If lPos = 0 Then lPos = lngMaxLength
> strNewLine = strNewLine & Left$(strLine, lPos) & vbCrLf
> strLine = Mid$(strLine, lPos + 1)
Rob
Robert Morley
and I was wrong, so just kill both the -1's. The only thing that was wrong,
then, was the accidental use of lngMaxLineLength in your code instead of
lngMaxTotalLength.
I'm gonna go have breakfast & coffee now (2 hours after I woke up)...maybe
I'll code better after that!
Rob
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:%233vJy$k7HHA...@TK2MSFTNGP06.phx.gbl...
Robert Morley
Suppose the person calls this with SplitText("0123456789", 20, 5). Right
now, the entire string will be returned, where it probably shouldn't be.
You would need to do one of the following:
- repeat the initial length check for lngMaxTotalLength, or
- add an extra clause to the If statement and let it fall through, or
- add "If lngMaxLineLength < lngMaxTotalLength Then
lngMaxLineLength = lngMaxTotalLength" at the beginning of the
procedure, or
- remove the initial quick check altogether.
Rob
RB Smissaert
file
Comment popup (see the earlier thread customise text file mouse over popup),
but I can see other uses for it such as in a custom msgbox I use. In any
case the
max line length will always be well below &H3FFFFFFF.
Haven't looked at any optimization as the won't be noticable with the
strings I am
dealing with. Always interested though in speed gains if only for some kind
of coder's
pride. I suppose I am not alone in this.
Could you post the whole final code when you think it is all done if that
ever where
the case?
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:%233vJy$k7HHA...@TK2MSFTNGP06.phx.gbl...
Robert Morley
> ever where the case?
This is what I have currently. In this case, I opted to remove the initial
"quick check" to deal with the case of having a maximum line length that was
longer than the maximum total length. As you've no doubt noticed by now,
I'm not a big fan of line-break characters. Since the only lines that will
actually be flush to the left margin at the function declarations and End
Function statements, I assume it's easy enough to figure out which lines
have wrapped because of the line length. (Oddly appropriate, considering
what this code is intended to do.)
Option Explicit
Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength As
Long, Optional ByVal lngMaxTotalLength As Long = 120)
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
If Mid$(strText, lngMaxTotalLength, 2) = vbCrLf Then
strText = Left$(strText, lngMaxTotalLength + 1)
Else
strText = Left$(strText, lngMaxTotalLength)
End If
varLines = Split(strText, vbCrLf)
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & SplitThisLine(varLines(i),
lngMaxLineLength)
Next
strNewText = Mid$(strNewText, 3)
If Mid$(strNewText, lngMaxTotalLength, 2) = vbCrLf Then
SplitText = Left$(strNewText, lngMaxTotalLength + 1)
Else
SplitText = Left$(strNewText, lngMaxTotalLength)
End If
End Function
Public Function SplitThisLine(ByVal strLine As String, ByVal lngMaxLength As
Long)
Dim strNewLine As String
Dim lPos As Long
strNewLine = vbNullString
Do While Len(strLine) > lngMaxLength
lPos = InStrRev(strLine, " ", lngMaxLength)
If lPos = 0 Then lPos = lngMaxLength
strNewLine = strNewLine & Left$(strLine, lPos) & vbCrLf
strLine = Mid$(strLine, lPos + 1)
RB Smissaert
> As you've no doubt noticed by now, I'm not a big fan of line-break
> characters.
Why is that? I used to go with Chr(13) but now nearly always use vbCrLf as
there
is less chance it will show wrong in other apps. Must admit never made a
deep study
of this.
One thing I was wondering is why you often use ByVal in your proc args when
there is
no need for it. Isn't ByRef a bit faster?
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:%239uvw0l...@TK2MSFTNGP05.phx.gbl...
dpb
> Thanks, will have a look at that.
>
>> As you've no doubt noticed by now, I'm not a big fan of line-break
>> characters.
>
> Why is that? I used to go with Chr(13) but now nearly always use vbCrLf
> as there is less chance it will show wrong in other apps. Must admit
> never made a deep study of this.
> One thing I was wondering is why you often use ByVal in your proc args
> when there is no need for it. Isn't ByRef a bit faster?
I don't have a clue what Robert is driving at w/ the comment re: line
break characters -- they're part of file structure for line-oriented-i/o
languages or for some other purposes, so they just "are". It's kinda' a
pita there couldn't have been better standardization across platforms so
transportation wouldn't be such a pita, but that's not the same as not
having one at all...
I'll take a stab at the ByVal vs default ByRef, though...
It is more for programming safety than performance--it enforces that the
intent of the routine is that the argument is to not be modified.
--
Robert Morley
not splitting lines of code in my posts and/or written code, using the "_"
line continuation character. It's strictly a stylistic thing for me, as I
can see reasons to wrap and reasons not to.
But to address your statement, yes, I always use vbCrLf as well, as it's
NEARLY universal...especially if you're only dealing with a PC.
As for the ByVal/ByRef thing, it depends entirely on what it is you're
passing. As a rule, you're right, though I'm a little rusty on the details.
I know it was discussed in a thread not that long ago. In a single-process
scenario, the difference is minute in most instances in any event. It
becomes a bigger concern when you get into cross-process data marshalling.
The reason I go with ByVal instead of ByRef comes from my
Pascal/structured-programming background, which basically says to always
declare a parameter how you intend to use it, and ignore speed
considerations unless they're overwhelming. Since I don't intend for these
variables to be modified and returned to the procedures that called them, I
declare them ByVal. This is particularly important in the SplitThisLine
procedure, since that actively modifies a variable that's being passed to
it, but it would probably be "a bad thing" for that to be passed back. (In
this code, it would make no difference, but in other code, it could be of
more importance.)
At the risk of getting thumped for talking about "that other non-VB thing",
you'll also see it in VB.NET apps, which are designed more with Web
programming in mind. Since passing variables ByRef to/from a web app
requires considerably more work than passing ByVal, the default was changed
to ByVal in VB.NET if you don't specify anything.
Rob
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:%23E9e5Bm...@TK2MSFTNGP04.phx.gbl...
RB Smissaert
Function SplitText(ByVal strText As String, _
ByRef lngMaxLineLength As Long, _
Optional ByRef lngMaxTotalLength As Long = -1)
Dim varLines As Variant
Dim strNewText As String
Dim i As Long
If lngMaxTotalLength > -1 Then
If Mid$(strText, lngMaxTotalLength, 2) = vbCrLf Then
strText = Left$(strText, lngMaxTotalLength + 1)
Else
strText = Left$(strText, lngMaxTotalLength)
End If
End If
varLines = Split(strText, vbCrLf)
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & _
SplitThisLine(varLines(i), lngMaxLineLength)
Next
SplitText = Mid$(strNewText, 3)
End Function
Main thing is that lngMaxTotalLength has to be with the optional value -1,
otherwise
we need another If in the function to see if there is no max total length.
The other thing is that I don't need the Left at the end as I don't mind the
added vbCrLf's
as visually they won't make the text wider.
Take for example "0123456789" with max line length 5
This should come out as:
"01234" & vbCrLf
"56789"
Let me know if you think I got something wrong here.
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:%239uvw0l...@TK2MSFTNGP05.phx.gbl...
Robert Morley
what I meant, why didn't everybody else? ;-) The message I just sent should
clarify what I was referring to...at least a bit, I hope.
Rob
"dpb" <no...@non.net> wrote in message news:fbhoav$e21$1...@aioe.org...
Robert Morley
> otherwise
> we need another If in the function to see if there is no max total length.
I had originally bypassed that by using the stupendously large value for the
optional parameter. There's no problem using -1, though, as long as you put
the appropriate checks in, as you have.
> The other thing is that I don't need the Left at the end as I don't mind
> the added vbCrLf's
> as visually they won't make the text wider.
This is only to keep it within the specified maximum TOTAL length; it has
nothing to do with line length whatsoever.
> Take for example "0123456789" with max line length 5
> This should come out as:
> "01234" & vbCrLf
> "56789"
It already does.
Rob
RB Smissaert
"01234567890123456789"
max line length and max total length 10.
This should come out as:
"01234" & vbCrLf
"56789"
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:uekTfYm7...@TK2MSFTNGP03.phx.gbl...
RB Smissaert
max line length 5 and max total length 10.
RBS
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:%23qOUxcm...@TK2MSFTNGP03.phx.gbl...
Mike Williams
> When I was talking about not being a fan of line-break characters,
> I mean not splitting lines of code in my posts and/or written code,
> using the "_" line continuation character. It's strictly a stylistic
> thing
> for me, as I can see reasons to wrap and reasons not to.
I'm not sure what point you're trying to make there Robert. When I look at
one of your postings in the newsgroup (such as the one to which I am now
responding) each paragraph of text is broken up into a number of individual
lines. It does /not/ wrap to the window, it "hard wraps" to a specific
maximum number of characters. Any long lines of VB code that are contained
in your posting do the same, so when I perform a copy and paste of any code
samples that your posting might contain VB cannot understand the lines of
code which contain these "hard line breaks" and they appear in the IDE in
red. That means I have to spend a lot of time editing the code in my own VB
IDE in order to get the code sample to work. As far as I know, this "hard
wrap" of long lines is caused at your end, not mine (for example, if you are
using Outlook Express or something similar and if your news sending format
is set to plain text with no encoding). You can of course change the
settings in your news program in various different ways to fix this problem,
but as it stands any code sample in your postings that contains lines of
code longer than about 76 characters will contain "hard line breaks" that
were not there when you typed it, and will cause the problems I have
described. If you wish to leave your news settings at they currently are
then it would probably be a good idea to use the VB "space underscore pair"
to break lomg lines up into smaller ones. Personally I leave my own news
settings to "hard wrap", because the aged email system we are all still
using has various other different problems with other plain text settings
and because most people do not like rich text in newsgroup postings, so I
always make sure that I use VB "space and underscore" method so that any
code samples I post will work straight away and the user simply needs to
perform a copy and paste and does not need to mess about fiddling with the
resultant code in the IDE in order to make it work. Or have I misunderstood
what you said?
Mike
Robert Morley
used any line continuation characters, and didn't believe in using them in a
newsgroup setting, since code is fairly easy to re-edit so that single lines
get put back to the way they were originally. I've got my font switched to
Times New Roman, for easier reading, so figuring out where OE intends to
hard-wrap my code is a matter of counting off 76 characters...not fun.
To answer your other questions/comments, yes, my news format is set to plain
text, UUencoded, with hard wraps at 76 characters. But other than
increasing the hard-wrapping limit of 76 characters to 132 characters (the
max that OE will allow), what else do you suggest?
And since we're massively off-topic here anyway, does anybody have any
recommendations for a better newsreader than OE? I've been starting to feel
some of OE's limitations lately, but have no clue what's out there. Maybe
that'll make the previous paragraph completely irrelevant. :-)
Rob
"Mike Williams" <mi...@whiskyandCoke.com> wrote in message
news:uS20U8m7...@TK2MSFTNGP03.phx.gbl...
Robert Morley
In that case, I think you'd have to do something a little more funky. I'm thinking you'd have to skip both the length checks that
were in my original code, and do something like this (dunno if this is necessarily the best solution...I suspect someone will come
up with something better, but this should work):
Public Function SplitText(ByVal strText As String, ByVal lngMaxLineLength As Long, Optional ByVal lngMaxTotalLength As Long = -1)
Dim varLines As Variant
Dim strNewText As String
Dim strVisText As String
Dim i As Long
varLines = Split(strText, vbCrLf)
strNewText = vbNullString
For i = LBound(varLines) To UBound(varLines)
strNewText = strNewText & vbCrLf & SplitThisLine(varLines(i), lngMaxLineLength)
Next
strNewText = Mid$(strNewText, 3)
strVisText = Replace(strNewText, vbCrLf, "")
If lngMaxTotalLength > -1 Then
If Len(strVisText) > lngMaxTotalLength Then
strNewText = Left$(strNewText, Len(strNewText) - (Len(strVisText) - lngMaxTotalLength))
End If
End If
SplitText = strNewText
End Function
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message news:%23qOUxcm...@TK2MSFTNGP03.phx.gbl...
RB Smissaert
posted last failed.
Have you seen any? I suppose there could be some trouble when there is a
vbCrLf at position
max line length in a line (as produced by the split on the original
vbCrLf's).
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:OjO$min7HH...@TK2MSFTNGP02.phx.gbl...
RB Smissaert
"012346789" & vbCrLf & "0123456789"
with max line 10 doesn't come out right.
Slim chance and not serious, but worth fixing.
Will have a look at this tomorrow.
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:OjO$min7HH...@TK2MSFTNGP02.phx.gbl...
RB Smissaert
I am coding in VBA, which doesn't have it, but I suppose I could use
TextWidth of VB to make it a bit more accurate still.
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:OjO$min7HH...@TK2MSFTNGP02.phx.gbl...
RB Smissaert
But maybe then I might as well use a textbox!
RBS
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:uD$CD1n7H...@TK2MSFTNGP03.phx.gbl...
Robert Morley
things that are part of VB that aren't part of VBA.
Rob
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message news:uD$CD1n7H...@TK2MSFTNGP03.phx.gbl...
Rick Rothstein (MVP - VB)
I just want to say that using the hidden TextBox and the code I posted
bypasses all of the contortions you and Rob are going through to make the
routine work. The concept behind my solution was to let Windows do all the
hard work of breaking the lines apart and simply use what it produces.
Rick
"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:uHB444n7...@TK2MSFTNGP03.phx.gbl...
RB Smissaert
we got now is contorted.
The reason I am not in favour of using a textbox is 2-fold.
Firstly, I would like the code to be general purpose as much as possible.
How about if you want to use it in an app with no form?
Secondly, coding it this way you have complete control over what is going
on,
something you may miss at one stage if you use a textbox.
RBS
"Rick Rothstein (MVP - VB)" <rickNOS...@NOSPAMcomcast.net> wrote in
message news:ecGD8go...@TK2MSFTNGP06.phx.gbl...
RB Smissaert
VBA doesn't have it, not Excel in any case and I would think same applies to
Access.
I do use it in a VB6 ActiveX dll that I use with VBA.
RBS
"Robert Morley" <rmo...@magma.ca.N0.Freak1n.sparn> wrote in message
news:O1EYwfo7...@TK2MSFTNGP05.phx.gbl...
Mike Williams
> Yes, based on visual (screen) width of the text. VBA doesn't
> have it, not Excel in any case and I would think same applies to Access. I
> do use it in a VB6 ActiveX dll that I use with VBA.
GetTextExtentPoint32 is available in VBA, and it is just as easy to use as
TextWidth and as an added bonus it is more accurate as well ;-)
Mike
bart.sm...@gmail.com
Of course it won't do the textbox job.
RBS