davis1118
04-02-2018, 06:54 PM
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
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