1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
| Option Explicit
Sub arobase()
Dim Lig As Long, DrLig As Long
Dim Col As Byte
Dim LienMail As String
'Supprime tous les liens de la feuille active
'si vous ne souhaitez pas supprimer préalablement les liens hypertextes,
'placez une apostrophe (') devant cette ligne :
ActiveSheet.Hyperlinks.Delete
'Dans la ligne suivante, il vous faut adapter le numéro de colonne
'indiquez quel numéro de colonne doit être traité
Col = 1 'indique ici le numéro de la colonne à traiter
'prise en compte de la remarque de Didier Gonard concernant la dernière ligne
'Excel 2007 peut être supérieure à 65536
DrLig = ActiveSheet.Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
'boucle sur toutes les lignes, dans la colonne concernée
For Lig = 1 To DrLig
'si la cellule contient un "@" alors
'2 méthodes différentes
'If Cells(Lig, Col) Like "*@*" Then
If InStr(Cells(Lig, Col), "@") <> 0 Then
LienMail = Cells(Lig, Col)
'on ajoute le lien dont on renseigne le texte à afficher et l'adresse de messagerie
ActiveSheet.Hyperlinks.Add Anchor:=Cells(Lig, Col), Address:="mailto:" & LienMail, TextToDisplay:=LienMail
End If
Next
End Sub |
Partager