Probleme de soulignement

Bonjour Excelleurs(es),

Je souhaite connaître comment bien souligner dans un shape.

la procédure que j'ai écrite :

Private Sub AddFormattedTextToShape(oShape As shape, sTitre As String, sTextNom As String, sTextTelephone As String, sTextEmail As String) 'Procédure pour les bulles insertion de coordonnée client et coordonnée responsable
    Dim sText As String
'  If Len(sTextNom) > 0 And Len(sTextTelephone) > 0 And Len(sTextEmail) > 0 Then
    'sText = "Contact Client : "
    With oShape.TextFrame
      .Characters.Text = sTitre & vbNewLine & "Nom : " & sTextNom & vbNewLine & "Tél : " & sTextTelephone & vbNewLine & "Email : " & sTextEmail
      .Characters.Font.Name = "HandelGothic"
      .Characters.Font.Size = 18
      .Characters(0, Len(sTitre)).Font.Underline = xlUnderlineStyleSingle 'xlUnderlineStyleNone
      .Characters(0, 6).Font.Underline = xlUnderlineStyleSingle '+ Len(sTextNom), Len("Nom")
      .Characters(0, 6).Font.Underline = xlUnderlineStyleSingle ' + Len(sTextNom) + Len("Nom"), Len("Tél")
      .Characters(0, 8).Font.Underline = xlUnderlineStyleSingle   '+ Len(sTextNom) + Len("Nom") + Len("Tél"), Len("Email")

      .HorizontalAlignment = xlHAlignLeft
      .VerticalAlignment = xlVAlignCenter

      'With .Characters(30, Length:=5).Font
        '.Underline = xlUnderlineStyleSingle
      'End With
    End With
  End If
End Sub

sa me souligne tous je veux que le soulignement s'arrête au deux points ":" sauf pour le titre.

A vous lire,

merci de votre lecture

UN PETIT UP