XL 2016 Changer la présentation du lien hypertexte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim strLien As String
    If Not Intersect(Target, Range("Tableau1[Liens]")) Is Nothing Then
        With Target
            If .Count = 1 Then
                If .Value = "" Then
                    strLien = Application.InputBox("Entrez le lien hypertexte.", "Insertion lien hypertexte", "Entrez le texte")
                    
                    Select Case strLien
                        Case False
                            MsgBox "Insertion du lien annulée", vbOKOnly + vbInformation, "Intertion de lien"
                        Case "Entrez le texte"
                            ' // Ici ton message

                        Case Else
                            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strLien _
                                                                                   , TextToDisplay:=Chr(158)
                            .Value = Chr(158)
                            .Font.Name = "Webdings"
                            .Font.Color = vbBlue
                            .Font.Size = 24
                            .Font.Underline = False
                    End Select

                End If
            End If
        End With
    End If

End Sub

Function RemoveCharAccents(ByVal TextToChange As String, Optional ByVal ToUpperCase As Boolean = False)
'Permet de substituer les accents d'un chaîne avec option MAJUSCULE
Const CHARS_WITH_ACCENTS As String = _
      "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöøùúûüýÿ"
'"ÀÁÂÃÄÅÈÉÊËÌÍÎÏÒÓÔÕÖØÙÚÛÜàáâãäåèéêëìíîïòóôõöøùúûüÿÑÇñç"
Const CHARS_WITHOUT_ACCENTS As String = _
      "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuyy"
'"AAAAAAEEEEIIIIOOOOOOOUUUUaaaaaaeeeeiiiioooooouuuuyNCnc"
Dim c As Integer
Dim strChar As String
Dim strNoAccentChars As String
Dim strFinalString As String

strFinalString = TextToChange
strNoAccentChars = CHARS_WITHOUT_ACCENTS
If ToUpperCase Then
    strNoAccentChars = UCase$(CHARS_WITHOUT_ACCENTS)
End If
For c = 1 To Len(CHARS_WITH_ACCENTS)
    strChar = Mid$(CHARS_WITH_ACCENTS, c, 1)

    If InStr(1, strFinalString, strChar, vbBinaryCompare) Then
        strFinalString = Replace(strFinalString, strChar, Mid$(strNoAccentChars, c, 1))
    End If
Next c
RemoveCharAccents = IIf(ToUpperCase, UCase(strFinalString), strFinalString)
End Function

If .Value = "" Then
                    strLien = RemoveCharAccents(Application.InputBox("Entrez le lien hypertexte.", "Insertion lien hypertexte", "Entrez le texte"))
                    
                    Select Case strLien
'...
'...