Sub SetLink()
Dim Cell As Range
For Each Cell In Selection
If InStr(Cell, "@") > 0 Then
If Cell.Hyperlinks.Count = 0 Then Cell.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=Cell, _
TextToDisplay:=Cell.Text, _
Address:="mailto:" & Cell.Text & "?subject=ceci est un sujet"
End If
Next
End Sub