Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim c As String 'déclare la variable c (Caractère)
Dim m As String 'déclare la variable m (Mot)
Dim i As Integer 'déclare la variable i (Incrément)
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne A
For Each cel In .Range("A2:A" & dl) 'boucle 1 : sur toutes les cellule éditées cel de la colonne A
m = "" 'réinitialise la variable m
For i = 1 To Len(cel.Value) 'boucle 2 : sur tos les caractères de la cellule cel
'si le caractère est souligné rajoute le caractère au mot m
If cel.Characters(Start:=i, Length:=1).Font.Underline = xlUnderlineStyleSingle Then m = m & Mid(cel.Value, i, 1)
Next i 'prochain caractère de la boucle 2
cel.Offset(0, 1).Value = m 'place le mot m dans la colonne B
Next cel 'prochaine cellule de la boucle 1
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub
Function ExtrSoulign(Cellule As Range) As String
Dim i As Long
ExtrSoulign = ""
For i = 1 To Len(Cellule)
If Cellule.Characters(Start:=i, Length:=1).Font.Underline <> xlUnderlineStyleNone Then
ExtrSoulign = ExtrSoulign & Cellule.Characters(Start:=i, Length:=1).Text
End If
Next i
End Function=extrsoulign(A2)
