Accueil Fonctions Calc Menu Basic EDI OOo 1.x EDI OOo 2.x EDI LibO - OOo 3.x Affectation touche Affectation icône Etape par étape Macro débutant Fonctions Basic Dialogues OOo1-2 Dialogues LibO-OOo3 Quelques exemples Exemples dialogue Fonctions perso Définitions Recherche sur site


Fonctions personnalisées 4. SUPPRIME_ACCENTS

 




Accès direct : page 1, page 2, page 3, page 4,


 

Autre fonction, la fonction que j'ai nommé SUPPRIME_ACCENTS et qui permet de supprimer les tous les accents d'un texte, des majuscules et / ou minuscules.

 

Cette fonction est librement utilisable et téléchargeable (10 ko) ici : http://christianwtd.free.fr/FicExemple/FonctionsPlus.ods
Il s'agit d'un classeur vide, mais qui contient un module macro intitulé : ModuleFonctionsPlus qui contient les fonctions INITIALES, SUPPRIME_ACCENTS et DATE_DIF
Restriction d'emploi : si un classeur circule entre différents utilisateurs et matériels, il faut soit que les fonctions accompagnent les classeurs, soit que tous les utilisateurs les aient installées.

 

Fonction SUPPRIME_ACCENTS (V1.0 complet)

  1. Function Supprime_Accents(Texte As String, Optional Majuscules As Boolean, Optional Minuscules As Boolean) As String
  2.   '-----------------------------------
  3.   ' SUPPRIME_ACCENTS Novembre 2006
  4.   ' Le tableur Calc par l'exemple
  5.   ' http://christianwtd.free.fr
  6.   '-----------------------------------
  7.   '
  8.   Dim Nc As Integer, n As Integer, Car As String
  9.   If IsMissing(Majuscules) Then Majuscules = True
  10.   If IsMissing(Minuscules) Then Minuscules = True
  11.   Nc = Len(Texte)
  12.   '
  13.   For n = 1 to Nc
  14.     Car = Mid(Texte, n, 1)
  15.     '
  16.     If Majuscules Then
  17.       If Car = "À" Or Car ="Á" Or Car ="Â" Or Car ="Ã" Or Car ="Ä" Or Car ="Å" Then
  18.         Car = "A"
  19.         Mid(Texte, n, 1) = Car
  20.       ElseIf Car = "Ç" Then
  21.         Car = "C"
  22.         Mid(Texte, n, 1) = Car
  23.       ElseIf Car = "È" Or Car ="É" Or Car = "Ê" Or Car = "Ë" Then
  24.         Car = "E"
  25.         Mid(Texte, n, 1) = Car
  26.       ElseIf Car = "Ì" Or Car = "Í" Or Car = "Î" Or Car = "Ï" Then
  27.         Car = "I"
  28.         Mid(Texte, n, 1) = Car
  29.       ElseIf Car = "Ñ" Then
  30.         Car = "N"
  31.         Mid(Texte, n, 1) = Car
  32.       ElseIf Car = "Ò" Or Car = "Ó" Or Car = "Ô" Or Car = "Õ" Or Car = "Ö" Then
  33.         Car = "O"
  34.         Mid(Texte, n, 1) = Car
  35.       ElseIf Car = "Ù" Or Car = "Ú" Or Car = "Û" Or Car = "Ü" Then
  36.         Car = "U"
  37.         Mid(Texte, n, 1) = Car
  38.       ElseIf Car = "Ý" Then
  39.         Car = "Y"
  40.         Mid(Texte, n, 1) = Car
  41.       ElseIf Car = "Ž" Then
  42.         Car = "Z"
  43.         Mid(Texte, n, 1) = Car
  44.       Endif
  45.     Endif
  46.     '
  47.     If Minuscules Then
  48.       If Car = "â" Or Car ="à" Or Car ="á" Or Car = "ã" Or Car ="ä" Or Car = "å" Then
  49.         Car = "a"
  50.         Mid(Texte, n, 1) = Car
  51.       ElseIf Car = "ç" Then
  52.         Car = "c"
  53.         Mid(Texte, n, 1) = Car
  54.       ElseIf Car = "é" Or Car ="è" Or Car = "ê" Or Car = "ë" Then
  55.         Car = "e"
  56.         Mid(Texte, n, 1) = Car
  57.       ElseIf Car = "î" Or Car = "ï" Then
  58.         Car = "i"
  59.         Mid(Texte, n, 1) = Car
  60.       ElseIf Car = "ñ" Then
  61.         Car = "n"
  62.         Mid(Texte, n, 1) = Car
  63.       ElseIf Car = "ò" Or Car = "ó" Or Car = "ô" Or Car = "õ" Or Car = "ö" Then
  64.         Car = "o"
  65.         Mid(Texte, n, 1) = Car
  66.       ElseIf Car = "û" Or Car = "ü" Then
  67.         Car = "u"
  68.         Mid(Texte, n, 1) = Car
  69.       ElseIf Car = "ý" Or Car = "ÿ" Then
  70.         Car = "y"
  71.         Mid(Texte, n, 1) = Car
  72.       Endif
  73.     Endif
  74.   Next n
  75.   Supprime_Accents=Texte
  76. End Function

 

 

Commentaires

Comme pour les autres fonctions, il suffit d'entrer =SUPPRIME_ACCENTS(cellule) ou =SUPPRIME_ACCENTS("données"). Dans les exemples suivants on suppose que les exemples sont dans la cellule A1

Données Remarques Valeur Commentaires
Texte Obligatoire   Si aucun texte, retourne la valeur zéro
Majuscules Option 0 ou 1 1 par défaut. Si valeur 0, aucune action
Minuscules Option 0 ou 1 1 par défaut. Si valeur 0, aucune action. Si on utilise cette option, il faut obligatoirement utiliser l'option précédente.

 

 

Au sujet de cette fonction

 

 

Les lignes 8 et 9 fixent les états par défaut. Si les Options Majuscules et Minuscules ne sont pas définies elles sont considérées comme étant à traiter.

dans une boucle For.. Next de 13 à 74, on traite caractère par caractère.

 

 

 

 

Cette nouvelle version fait exactement la même chose, mais utilise les Select Case au lieu des If.. Then.. Else

Fonction SUPPRIME_ACCENTS (V1.1 complet)

  1. Function Supprime_Accents(Texte As String, Optional Majuscules As Boolean, Optional Minuscules As Boolean) As String
  2.   '--------------------------------------
  3.   ' SUPPRIME_ACCENTS Décembre 2006 - v1.1
  4.   ' Le tableur Calc par l'exemple
  5.   ' http://christianwtd.free.fr
  6.   '--------------------------------------
  7.   '
  8.   Dim Nc As Integer, n As Integer, Car As String
  9.   If IsMissing(Majuscules) Then Majuscules = True
  10.   If IsMissing(Minuscules) Then Minuscules = True
  11.   Nc = Len(Texte)
  12.   '
  13.   For n = 1 to Nc
  14.     Car = Mid(Texte, n, 1)
  15.     '
  16.     If Majuscules Then
  17.       Select Case Car
  18.         Case "À", "Á", "Â", "Ã", "Ä", "Å"
  19.         Car = "A"
  20.         Mid(Texte, n, 1) = Car
  21.         Case "Ç"
  22.         Car = "C"
  23.         Mid(Texte, n, 1) = Car
  24.         Case "È", "É", "Ê", "Ë"
  25.         Car = "E"
  26.         Mid(Texte, n, 1) = Car
  27.         Case "Ì", "Í", "Î", "Ï"
  28.         Car = "I"
  29.         Mid(Texte, n, 1) = Car
  30.         Case "Ñ"
  31.         Car = "N"
  32.         Mid(Texte, n, 1) = Car
  33.         Case "Ò", "Ó", "Ô", "Õ", "Ö"
  34.         Car = "O"
  35.         Mid(Texte, n, 1) = Car
  36.         Case "Ù", "Ú", "Û", "Ü"
  37.         Car = "U"
  38.         Mid(Texte, n, 1) = Car
  39.         Case "Ý"
  40.         Car = "Y"
  41.         Mid(Texte, n, 1) = Car
  42.         Case "Ž"
  43.         Car = "Z"
  44.         Mid(Texte, n, 1) = Car
  45.       End Select
  46.     Endif
  47.     '
  48.     If Minuscules Then
  49.       Select Case Car
  50.         Case "â", "à", "á", "ã", "ä", "å"
  51.         Car = "a"
  52.         Mid(Texte, n, 1) = Car
  53.         Case "ç"
  54.         Car = "c"
  55.         Mid(Texte, n, 1) = Car
  56.         Case "é", "è", "ê", "ë"
  57.         Car = "e"
  58.         Mid(Texte, n, 1) = Car
  59.         Case "î", "ï"
  60.         Car = "i"
  61.         Mid(Texte, n, 1) = Car
  62.         Case "ñ"
  63.         Car = "n"
  64.         Mid(Texte, n, 1) = Car
  65.         Case "ò", "ó", "ô", "õ", "ö"
  66.         Car = "o"
  67.         Mid(Texte, n, 1) = Car
  68.         Case "û", "ü"
  69.         Car = "u"
  70.         Mid(Texte, n, 1) = Car
  71.         Case "ý", "ÿ"
  72.         Car = "y"
  73.         Mid(Texte, n, 1) = Car
  74.       End Select
  75.     Endif
  76.   Next n
  77.   Supprime_Accents=Texte
  78. End Function

 

 


 


 
Ce site n'est plus mis à jour. Merci aux nombreux visiteurs depuis 2003. Consultez le Wiki LibreOffice.
   

Le tableur Calc par l'exemple : christianwtd@free.fr
Creative Commons License
This work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 2.0 France License.

  .

Site optimisé pour Firefox

Dernière modification : 29/08/2010 à 18h47


Déjà plusieurs visites sur ce site depuis quelque temps (au moins vous et moi)
Compteur non certifié