Underlining bottom word in Wrapped cell

[Jeffrey Mahoney]

I'm making headers for an income statement report. The headers change depending on the type of report it is. When a cell is wrapped and the words are in multiple rows I have a problem getting only the words on the bottom to underline. I can use this code, but the user has the ability to change the text in the cell and so it messes up the underline.

IncHdr.Offset(0, 3).Characters(Start:=8, Length:=9).Font.Underline = xlUnderlineStyleSingle

Is there a way to detect which words are on the bottom of the multiple lines? I'm thinking not. Only other way I can think of making it right is to have multiple rows for the words.

Better or Worse Than Budget

<tbody>
</tbody>

 

[Jaafar Tribak]

what happens if the last word at the bottom spans more than the last line ? like

Better or Worse Than WWW.MrExc el.COM

<tbody>
</tbody>

Is the integrity of the last word always contained within one line ? ie: within the last line ?

 

[Rick Rothstein]

what happens if the last word at the bottom spans more than the last line ? like

Better or Worse Than WWW.MrExc el.COM

<tbody>
</tbody>

Is the integrity of the last word always contained within one line ? ie: within the last line ?

In addition to Jaafar's question, I have a question as well... is the text in the cell a constant or is it the result of a formula in the cell?

 

[Jeffrey Mahoney]

Thank you.

Ok, I'm putting ownership on the end user to make sure the word or words at the bottom don't span multiple lines. They also have the freedom to choose the width. I'm running a lengthy macro that reads the cell on the "Options" sheet to fill in the headers for the report. So, It could be longer or shorter, depending on the user.

Jeff

 

[Jaafar Tribak]

This task turned out rather challenging .. I have tried different approaches including getting the pixels size of the cell's text but with no luck

The closest I have come to is to use a temporary hidden textbox, place the cell text in it and take advantage of the Lines Count Property of the TextFrame Object to localise the bottom line .. This works most of the time (Not Always) .. It starts giving inconsistent results if the text has many repetitive letters or spaces but that is unlikely

Anyway, give this sloppy workaround a shot and see what you get:

Sub UnderlineBottomWords(ByVal Cell As Range)
    Dim oShp     As Shape
    Dim lStart   As Long
    Dim lLength  As Long

    On Error GoTo err_Handler
    With Cell
        Set oShp = Cell.Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        .Left, .Top, .Width, .Height)
        .Font.Underline = False
    End With
    oShp.Name = "Temp"
    With oShp.TextFrame2.TextRange
        .TEXT = Cell.TEXT
        .Font.NameAscii = Cell.Font.Name
        .Font.SIZE = Cell.Font.SIZE
        lStart = .Lines(.Lines.Count).Start
        lLength = .Lines(.Lines.Count).Length
    End With
    Cell.Characters(Start:=lStart, Length:=lLength).Font.Underline = xlUnderlineStyleSingle
    oShp.Delete
    Set oShp = Nothing
    Exit Sub
err_Handler:
    Cell.Parent.Shapes("Temp").Delete
    MsgBox "An error has occurred! " & vbLf & "Error Number: " _
    & Err.Number & vbLf & Err.Description, vbExclamation
End Sub

Public Sub Test()
    UnderlineBottomWords Sheet1.Range("a1")
End Sub

 

[Jeffrey Mahoney]

Thank you Jaafar. I thought maybe there was built in features for a cell to detect the number of lines. Seems only available for a textframe. I'll try it out. Seems odd though that you delete the shape before copying and pasting the text into the cell.

 

[Jaafar Tribak]

Thank you Jaafar. I thought maybe there was built in features for a cell to detect the number of lines. Seems only available for a textframe. I'll try it out. Seems odd though that you delete the shape before copying and pasting the text into the cell.

If instead of having the cells wrapped, the wrapping was done manually by entering a break line via ALt+ Enter keys then one could figure out the number of lines in the cell which would be the total number of Chr(10) s - 1

The shape is deleted because copying the shape text into the wrapped cell has no effect.

 

[Rick Rothstein]

The closest I have come to is to use a temporary hidden textbox, place the cell text in it and take advantage of the Lines Count Property of the TextFrame Object to localise the bottom line .. This works most of the time (Not Always) .. It starts giving inconsistent results if the text has many repetitive letters or spaces but that is unlikely

It might have something to do with the margins... setting them to 1 might yield better results. Here is your code modified to do that.

Sub UnderlineBottomWords(ByVal Cell As Range)
    Dim oShp     As Shape
    Dim lStart   As Long
    Dim lLength  As Long

    On Error GoTo err_Handler
    With Cell
        Set oShp = Cell.Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        .Left, .Top, .Width, .Height)
        .Font.Underline = False
    End With
    oShp.Name = "Temp"
    With oShp.TextFrame2
      .MarginLeft = 1
      .MarginRight = 1
      .MarginTop = 1
      .MarginBottom = 1
      With .TextRange
        .Text = Cell.Text
        .Font.NameAscii = Cell.Font.Name
        .Font.Size = Cell.Font.Size
        lStart = .Lines(.Lines.Count).Start
        lLength = .Lines(.Lines.Count).Length
      End With
    End With
    Cell.Characters(Start:=lStart, Length:=lLength).Font.Underline = xlUnderlineStyleSingle
    oShp.Delete
    Set oShp = Nothing
    Exit Sub
err_Handler:
    Cell.Parent.Shapes("Temp").Delete
    MsgBox "An error has occurred! " & vbLf & "Error Number: " _
    & Err.Number & vbLf & Err.Description, vbExclamation
End Sub

Note: Your code assumes the text in the TextBox is "normal" and uniform... if parts of it are, say, italicized or bold, then I think your code will fail a noticeable amount of times because the character widths will be different between the cell and your TextBox. Also, your code will outright crash if individual characters have a different size than the rest of the text (your Font.Size assignment will crash because the Cell's Font.Size attribute will be Null due to the mixed sizes). You could overcome this by iterating every font property for each individual character in the cell and assigning those properties to the individual character in your TextBox, but that would be time consuming, especially if there were lots of text in the cell or lots of cells needed to be processed or both.

 

[Jeffrey Mahoney]

Um, hey guys :/ I thought this would be a simple. Yes, I could fiddle around with that code. I like the idea of using the hard returns to force multiple lines. That should be good enough.

Now please go help less fortunate people than myself. Sheesh, go enjoy your Sunday!!!

 

[Rick Rothstein]

Um, hey guys :/ I thought this would be a simple. Yes, I could fiddle around with that code. I like the idea of using the hard returns to force multiple lines. That should be good enough.

With the exception of what I pointed out in my Note, I think the modification I made to Jaafar's code will make it work quite reliably, at least it did in my limited testing (hopefully when Jaafar comes back online, he will test it against the cases he pointed out his original code had problems with).

Sheesh, go enjoy your Sunday!!!

I am enjoying myself... besides, I am retired, every day is a Sunday for me.