Underline specific text in shape caption. (Excel 2013)

[davis1118]

Just when I think I have things all set in place, I find another part of the code to work on and I end up here again. I am creating shapes from a userform, and hyperlinking the shapes to documents.

Everything is working perfectly for creating the buttons, but I thought it would be a great idea if I could have only a portion of the caption underlined to help the user see the difference between the different lines on the caption.
The caption of the shape can vary depending on what was selected on the userform, so the caption can be either 1, 2, or 3 lines. The caption is made up from three comboboxes; "Machine", "Customer" and "DocName". I'm not sure if it's possible to underline only the machine value of the caption, but that is what I was hoping for. Most examples I seem to find are for underlining text in a cell but not a shape. I did try recording a macro and it doesn't record anything when I underline part of the caption. The code below is what I am using to create the caption and the shape.
(Disclaimer: I'm aware that the code might be ugly. I don't know all the "fancy" ways to write out code so I stick with what seems logical to me. But feel free to tell me if there is a simpler way.)

Thank you for the help!



'BUTTON 1
If PRODForm.DocName1.Value <> "" Then

Set topcell = .Range("Prod" & process & "_Top")

'SET VALUES FOR CAPTION
With PRODForm
If .Machine1.Value = "" And .Customer1.Value = "" Then
topCaption = .DocName1.Value
ElseIf .Machine1.Value = "" And .Customer1.Value <> "" Then
topCaption = .Customer1.Value & Chr(10) & .DocName1.Value
ElseIf .Machine1.Value <> "" And .Customer1.Value = "" Then
topCaption = .Machine1.Value & Chr(10) & .DocName1.Value
Else
topCaption = .Machine1.Value & Chr(10) & .Customer1.Value & Chr(10) & .DocName1.Value
End If
End With
'CREATE NAMES AND SHAPES
topName = "Prod" & process & "Btn1_Top"

Set topBtn = .Shapes.AddShape(msoShapeRoundedRectangle, Left:=topcell.Left, Top:=topcell.Top, Width:=topcell.Width, Height:=topcell.Height)

With topBtn
.name = topName
.TextFrame.Characters.Text = topCaption
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignCenter
.Fill.ForeColor.RGB = color
End With

'CREATE HYPERLINKS
.Hyperlinks.Add Anchor:=.Shapes("Prod" & process & "Btn1_Top"), address:=PRODForm.PDFLink1.Value, SubAddress:="", ScreenTip:=PRODForm.DocName1.Value

End If

[p45cal]

Try changing your With PRODForm code to:
With PRODForm
StartUnderline = 0 'added line.
LengthUnderline = Len(.Machine1.Value) 'added line.
If .Machine1.Value = "" And .Customer1.Value = "" Then
topCaption = .DocName1.Value
ElseIf .Machine1.Value = "" And .Customer1.Value <> "" Then
topCaption = .Customer1.Value & Chr(10) & .DocName1.Value
ElseIf .Machine1.Value <> "" And .Customer1.Value = "" Then
topCaption = .Machine1.Value & Chr(10) & .DocName1.Value
StartUnderline = 1 'added line.
Else
topCaption = .Machine1.Value & Chr(10) & .Customer1.Value & Chr(10) & .DocName1.Value
StartUnderline = 1 'added line.
End If
End With
Then in the With topBtn code, somewhere after the .TextFrame.Characters.Text = topCaption line, add this:

If StartUnderline > 0 Then .TextFrame2.TextRange.Characters(StartUnderline, LengthUnderline).Font.UnderlineStyle = msoUnderlineSingleLineDifficult to test here.

[davis1118]

That is too cool, it works perfectly! I would have never thought that was going to be possible. I can't thank you enough p45cal. This is now the 2nd time you have helped me out, and I have learned some good techniques from that help.

Thank you very much! :clap: