Texte PREMLETTRE

Staple1600 · 21 Avril 2021

Bonjour,

Une fonction utilisable dans l'univers Windows uniquement

VB:

Function PREMLETTRE(S$) As String
Dim mc As Object, m As Object
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\b\w"
    If .test(S) = True Then
        Set mc = .Execute(S)
        For Each m In mc
            PREMLETTRE = UCase(PREMLETTRE & m) & "."
            Next m
        End If
End With
End Function

Exemple d'usage
En A1: darkside of the moon
en B1 =PREMLETTRE(A1) renvoie D. S. O. T. M.

Ci dessous une variante avec choix de la casse

VB:

Function PREMLETTRE(S$, Optional casse As VbStrConv) As String
Dim mc As Object, m As Object
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\b\w"
    If .test(S) = True Then
        Set mc = .Execute(S)
        For Each m In mc
            PREMLETTRE = StrConv(PREMLETTRE & m, casse) & "."
            Next m
        End If
End With
End Function

Avec comme paramétres : 1, 2 ou 3
=PREMLETTRE(A1;1) -< MAJUSCULE
=PREMLETTRE(A1;2) -< minuscule
=PREMLETTRE(A1;3) -< Nom propre

patricktoulon · 21 Avril 2021

re
Staple1600
PLTR??????????(remplacé par "PREMLETTRE"

il manque le "S" chez moi

Staple1600 · 21 Avril 2021

Bonjour patricktoulon

Erreur de copier/coller
J'ai corrigé dans le message initial

Chez moi, j'ai bien le S avec les deux fonctions.

Magic_Doctor · 24 Avril 2021

Bonjour,

Personnellement, j'aurais intitulé cette fonction "Acronyme".
Cette fonction, telle qu'elle est, marche bien, mais uniquement en anglais ou toute autre langue sans diacritiques. Je m'explique :
- darkside of the moon --> D.O.T.M. (OK)
- dark side of the moon --> D.S.O.T.M. (OK)
- confédération générale des nanas révolutionnaires --> C.D.R.G.N.R.D.N.R.V. (NO OK)
On sattendait à : C.G.D.N.R.
- comisión de los niños rebeldes --> C.N.D.L.N.O.R. (NO OK)
on s'attendait à : C.D.L.N.R.

Dudu2 · 28 Avril 2021

Bonjour @Staple1600, @patricktoulon, @Magic_Doctor,
A défaut (pour moi en tous cas) de savoir comment expliciter les lettres accentuées en expression régulière, cette fonction.

mapomme · 1 Mai 2021

Bonjour à tous,

Ne pouvant pas me résoudre à délaisser ceux qui errent désespérément dans l'univers PC alors qu'ils utilisent un ustensile électronique de type "Apple" (mapomme forcément est solidaire), une version qui fonctionne dans les deux univers. Deux macros distinctes pouvant être utilisées séparément.

une fonction personnalisée pour les premières lettres: PremiersCar
une fonction personnalisée pour ôter les accents: SansAccent

Les codes :

VB:

Function PremiersCar$(ByVal s$, Optional ByVal sep As String = ".")
Dim r$, x
   For Each x In Split(Application.Proper(Application.Trim(s))): r = r & Left(x, 1) & sep: Next
   PremiersCar = r
End Function

Function SansAccent(ByVal x)
Const lettresAvec = "Ÿ,À,Á,Â,Ã,Ä,Å,Ç,È,É,Ê,Ë,Ì,Í,Î,Ï,Ñ,Ò,Ó,Ô,Õ,Ö,Ù,Ú,Û,Ü,Ý,à,á,â,ã,ä,å,ç,è,é,ê,ë,ì,í,î,ï,ñ,ò,ó,ô,õ,ö,ù,ú,û,ü,ý,ÿ"
Const lettresSans = "Y,A,A,A,A,A,A,C,E,E,E,E,I,I,I,I,N,O,O,O,O,O,U,U,U,U,Y,a,a,a,a,a,a,c,e,e,e,e,i,i,i,i,n,o,o,o,o,o,u,u,u,u,y,y"
Dim i&, j&
   For i = 1 To Len(x)
      j = InStr(lettresAvec, Mid(x, i, 1))
      If j > 0 Then x = Replace(x, Mid(x, i, 1), Mid(lettresSans, j, 1))
   Next i
   x = Replace(x, UCase("œ"), "OE"): x = Replace(x, "œ", "oe")
   x = Replace(x, UCase("æ"), "AE"): x = Replace(x, "æ", "ae")
   SansAccent = x
End Function

Texte PREMLETTRE

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Discussions similaires