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 = msoUnderlineSingleLine

Difficult 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!