Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
XL 2010RESOLU Extraction par macro des initiales de chaque mot d'une cellule active
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 !
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim TabTemp, i As Integer, Chaine As String
TabTemp = Split(Target, " ")
For i = LBound(TabTemp) To UBound(TabTemp)
Chaine = Chaine & Left(TabTemp(i), 1) & " "
Next
Target = Chaine
End Sub
Le code de Paf correspond plus à la demande de jozerebel, je suis parti sur les deux premières lettre sans me préoccuper des initiales c'était trop simple 🙁
Je reviens concurrencer Paf avec une nouvelle tentative ! 😉
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Lg, i As Integer, Initiale As String, Cible As Variant
Cible = ActiveCell.Value
Lg = Len(Cible)
Initiale = Left(Cible, 1)
If Lg > 2 Then
For i = 2 To Lg
If Mid(Cible, i - 1, 1) = " " Then
Initiale = Initiale & Mid(Cible, i, 1)
End If
Next i
End If
ActiveCell.Value = Initiale
End Sub
Attendons les précisions de jozerebel quant à l'éventuel séparateur d'initiales, et aux restrictions de plage de cellules où cliquer .....
Par ailleurs, Target et ActiveCell représentent le même range.
donc le test If Not Application.Intersect(Target, ActiveCell) Is Nothing Then sera toujours vrai!!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x$, i!
x = Left(Target, 1)
For i = 1 To Len(Target)
x = x & IIf(Mid(Target, i, 1) = " ", Mid(Target, i + 1, 1), "")
Next
Target = UCase(x)
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD