Fonction LS "simple" pour enlever les accents

Forum destiné aux questions sur le développement : Formules, LotusScript, Java ...

Fonction LS "simple" pour enlever les accents

Messagepar Mick » 25 Avr 2012 à 15:30

Bonjour

J'ai bien écumé le forum sans vraiment trouver LA solution qui me convient.

J'ai un agent qui récupère les données d'un champs pour les intégrer dans un fichier texte, le problème c'est le champs contient des accents.

Je souhaiterais pouvoir récupérer le contenu du champs sans les accents mais je n'ai pas trouvé le moyen de faire cela en LS ...

champs1 = matière
champs2 = fonction sans les accents(champs1) qui me ressort donc matiere


Merci à vous,
:?:
Mick
Apprenti-posteur
Apprenti-posteur
 
Message(s) : 170
Inscrit(e) le : 09 Juin 2009 à 09:39

Re: Fonction LS "simple" pour enlever les accents

Messagepar Michael DELIQUE » 25 Avr 2012 à 15:51

Hello

j'ai ça
Code : Tout sélectionner
Public Function FormatGBString(Byval wSource As String,nbFull As Integer) As String
   REM  remplace tous les caratères accentués
   Dim CarSource As String
   Dim CarCible As String
   Dim CarReplace As String
   Dim nbCarReplace As String
   Dim i As Integer
   
   On Error Goto CatchError
   
   FormatGBString = wSource   
   If Trim(wSource) ="" Then
      Exit Function
   End If   
   If nbFull = True Then
      CarSource = "àáâãäåaaaÁÀÂÃÄÅAAAèéêëeeeeÈÉÊËEEEEìíîïiiiiÌÍÎÏIIIIIòóôõöoooÒÓÔÕÖOOOùúûüuuuuuuÙÚÛÜUUUUUUçccccÇCCCCñÑ"
      CarCible = "aaaaaaaaaAAAAAAAAAeeeeeeeeEEEEEEEEiiiiiiiiIIIIIIIIIooooooooOOOOOOOOuuuuuuuuuuUUUUUUUUUUcccccCCCCCnN"
   Else
      CarSource = "äàâéèêëîïôöùûüçñÑÀÂÉÈÊËÎÏÔÙÛÇ"
      CarCible = "aaaeeeeiioouuucnNAAEEEEIIOUUC"
   End If   
   For i = 1 To Len(CarSource)
      CarReplace = Mid$(CarSource,i,1)
      nbCarReplace = Instr( 1, FormatGBString,CarReplace,0)
      Do While nbCarReplace <> 0
         Mid$(FormatGBString,nbCarReplace,1) = Mid$(CarCible,i,1)
         nbCarReplace = Instr( 1, FormatGBString,CarReplace,0)
      Loop
      CarReplace = ""
      nbCarReplace  = 0
   Next   
   Exit Function
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   FormatGBString = ""
   Exit Function   
End Function
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Re: Fonction LS "simple" pour enlever les accents

Messagepar Mick » 25 Avr 2012 à 16:29

Merci,

C'est en test ...
Mick
Apprenti-posteur
Apprenti-posteur
 
Message(s) : 170
Inscrit(e) le : 09 Juin 2009 à 09:39


Retour vers Développement