jungix
07-17-2006, 09:12 AM
I have a little problem with this KB article
http://vbaexpress.com/kb/getarticle.php?kb_id=421
Unfortunately I am unable to understand all of it. Has someone used it and tested it? Usually with a lineIncr of .Columnwidth the column is not filled entirely to the right. I put 1.05*.Columnwidth which is already better but still not enough to fill my column. But I can't put more because otherwise when a long word is at the end of one line, the feed is done before and then there is a long word starting a line but not being taken into account in the counting of the characters (I think) because sometimes the last word of the next line is then alone on a line after the feed.
Do you know what I could change about it (changing the number of characters in a line adding the last word after the last space and the line feed)?
I join the modify code I use (slightly modified) and that does not work perfectly well.
Option Explicit
Sub DisplayLongText()
'Adds line feed characters as required on cells in selection that are longer than 1024 characters
Dim cel As Range
Dim col As Long
For Each cel In Selection
AddLineFeeds cel, col
Next
col = 0 'Force line length dialog to display the next time sub runs
End Sub
Sub AddLineFeeds(cel As Range, col As Long)
'Adds line feed characters at end of each line of text. Some experimentation may be required to set number
'of characters at the wrapping point.
'Code requires Excel 2000 or later because of Replace and InStrRev functions
Static lineIncr As Long
Dim i As Long, j As Long, pos As Long, StartPos As Long
Dim sLeft As String, str As String, sRight As String, sLineFeed As String
StartPos = 1 'Value should be between 1 and 1022. The first 1022 characters (plus ASCII 160 & line feed)
'will always fit correctly. The macro will add ASCII 160 space plus line feed characters
'to each line after character StartPos. You may notice that the beginning section of text
'uses a different "break" point than the end. If this bothers you, set StartPos=1;
'it will be reset to the chosen line length later in the sub.
With cel
col = 0
If Len(.Value) <= 1022 Then Exit Sub
'Remove line feed characters which may have been added previously. These always follow an ASCII 160 space.
sLineFeed = Chr(160) & Chr(10) 'Code puts an ASCII 160 space before every added line feed character
str = Replace(.Value, sLineFeed, " ")
ActiveCell.RowHeight = 20
'The maximum permitted number of characters on a line. User-specified up to a limit of 256 characters/line
If .Column <> col Then 'Use same value as last time if still working in same column
lineIncr = .ColumnWidth * 1.05
col = .Column
If StartPos < lineIncr Then StartPos = lineIncr
End If
sLeft = Left$(str, StartPos) 'Excel has no problem wrapping the first 1024 characters
pos = InStrRev(sLeft, " ") 'Find right-most space in first 1022 characters
If pos = 0 Then 'No space found, so force a break after 1022 characters
sLeft = sLeft & sLineFeed
sRight = Mid$(str, StartPos + 1)
ActiveCell.RowHeight = ActiveCell.RowHeight + 12.5
Else 'Put ASCII 160 plus line feed characters in place of this right-most space
sLeft = Left$(str, pos - 1) & sLineFeed
sRight = Mid$(str, pos + 1)
ActiveCell.RowHeight = ActiveCell.RowHeight + 12.5
End If
pos = 1 'Loop through remainder of text, looking for places to put ASCII 160 plus line feed characters
Do
j = InStr(pos, sRight, Chr(10))
If j > 0 And j - pos <= lineIncr Then
pos = j + 1
Else
i = InStrRev(sRight, " ", pos + lineIncr) 'Find right-most space in next lineIncr characters
If i > pos Then 'Put ASCII 160 plus line feed characters in place of this right-most space
sRight = Left$(sRight, i - 1) & sLineFeed & Mid$(sRight, i + 1)
pos = i + 2
Else 'Didn't find a good place to break the line, so force the break in middle of a word
sRight = Left$(sRight, pos + lineIncr) & sLineFeed & Mid$(sRight, pos + lineIncr + 1)
pos = pos + lineIncr + 3
End If
End If
If ActiveCell.RowHeight < 397 Then
ActiveCell.RowHeight = ActiveCell.RowHeight + 12.5
End If
If Len(sRight) - pos < lineIncr Then Exit Do 'Not enough text left for a full line
Loop
.Value = sLeft & sRight 'Put the rebuilt string in place of the original
End With
End Sub
Thank you
http://vbaexpress.com/kb/getarticle.php?kb_id=421
Unfortunately I am unable to understand all of it. Has someone used it and tested it? Usually with a lineIncr of .Columnwidth the column is not filled entirely to the right. I put 1.05*.Columnwidth which is already better but still not enough to fill my column. But I can't put more because otherwise when a long word is at the end of one line, the feed is done before and then there is a long word starting a line but not being taken into account in the counting of the characters (I think) because sometimes the last word of the next line is then alone on a line after the feed.
Do you know what I could change about it (changing the number of characters in a line adding the last word after the last space and the line feed)?
I join the modify code I use (slightly modified) and that does not work perfectly well.
Option Explicit
Sub DisplayLongText()
'Adds line feed characters as required on cells in selection that are longer than 1024 characters
Dim cel As Range
Dim col As Long
For Each cel In Selection
AddLineFeeds cel, col
Next
col = 0 'Force line length dialog to display the next time sub runs
End Sub
Sub AddLineFeeds(cel As Range, col As Long)
'Adds line feed characters at end of each line of text. Some experimentation may be required to set number
'of characters at the wrapping point.
'Code requires Excel 2000 or later because of Replace and InStrRev functions
Static lineIncr As Long
Dim i As Long, j As Long, pos As Long, StartPos As Long
Dim sLeft As String, str As String, sRight As String, sLineFeed As String
StartPos = 1 'Value should be between 1 and 1022. The first 1022 characters (plus ASCII 160 & line feed)
'will always fit correctly. The macro will add ASCII 160 space plus line feed characters
'to each line after character StartPos. You may notice that the beginning section of text
'uses a different "break" point than the end. If this bothers you, set StartPos=1;
'it will be reset to the chosen line length later in the sub.
With cel
col = 0
If Len(.Value) <= 1022 Then Exit Sub
'Remove line feed characters which may have been added previously. These always follow an ASCII 160 space.
sLineFeed = Chr(160) & Chr(10) 'Code puts an ASCII 160 space before every added line feed character
str = Replace(.Value, sLineFeed, " ")
ActiveCell.RowHeight = 20
'The maximum permitted number of characters on a line. User-specified up to a limit of 256 characters/line
If .Column <> col Then 'Use same value as last time if still working in same column
lineIncr = .ColumnWidth * 1.05
col = .Column
If StartPos < lineIncr Then StartPos = lineIncr
End If
sLeft = Left$(str, StartPos) 'Excel has no problem wrapping the first 1024 characters
pos = InStrRev(sLeft, " ") 'Find right-most space in first 1022 characters
If pos = 0 Then 'No space found, so force a break after 1022 characters
sLeft = sLeft & sLineFeed
sRight = Mid$(str, StartPos + 1)
ActiveCell.RowHeight = ActiveCell.RowHeight + 12.5
Else 'Put ASCII 160 plus line feed characters in place of this right-most space
sLeft = Left$(str, pos - 1) & sLineFeed
sRight = Mid$(str, pos + 1)
ActiveCell.RowHeight = ActiveCell.RowHeight + 12.5
End If
pos = 1 'Loop through remainder of text, looking for places to put ASCII 160 plus line feed characters
Do
j = InStr(pos, sRight, Chr(10))
If j > 0 And j - pos <= lineIncr Then
pos = j + 1
Else
i = InStrRev(sRight, " ", pos + lineIncr) 'Find right-most space in next lineIncr characters
If i > pos Then 'Put ASCII 160 plus line feed characters in place of this right-most space
sRight = Left$(sRight, i - 1) & sLineFeed & Mid$(sRight, i + 1)
pos = i + 2
Else 'Didn't find a good place to break the line, so force the break in middle of a word
sRight = Left$(sRight, pos + lineIncr) & sLineFeed & Mid$(sRight, pos + lineIncr + 1)
pos = pos + lineIncr + 3
End If
End If
If ActiveCell.RowHeight < 397 Then
ActiveCell.RowHeight = ActiveCell.RowHeight + 12.5
End If
If Len(sRight) - pos < lineIncr Then Exit Do 'Not enough text left for a full line
Loop
.Value = sLeft & sRight 'Put the rebuilt string in place of the original
End With
End Sub
Thank you