begin process at 2012 02 11 23:55:07
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Texte

 > EMULATION DE LA FONCTION REPLACE() DE VBA6

EMULATION DE LA FONCTION REPLACE() DE VBA6


 Information sur la source

Note :
10 / 10 - par 1 personne
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Texte Niveau :Initié Date de création :20/07/2002 Date de mise à jour :31/07/2002 17:44:20 Vu :5 369

Auteur : bigane

Ecrire un message privé
Commentaire sur cette source (7)
Ajouter un commentaire et/ou une note

 Description

La fonction Replace() n'est pas disponible sous toutes les versions de VBA, en voici une émulation qui permet d'utiliser un code VB6 sous Access 97 par exemple.
Le code est rapide, mais il peut être accéléré si on retire les options non utilisées.

bigane
    

Source

  • ' ----------------------------------------------------------------------------
  • ' Description
  • ' Renvoie une chaîne dans laquelle une sous-chaîne spécifiée a été
  • ' remplacée plusieurs fois par une autre sous-chaîne.
  • ' Syntaxe
  • ' Replace(expression, find, replacewith[, start[, count[, compare]]])
  • '
  • ' expression
  • ' Expression de chaîne contenant une sous-chaîne à remplacer.
  • ' find
  • ' Sous-chaîne recherchée.
  • ' replacewith
  • ' Sous-chaîne de remplacement.
  • ' start (Facultatif)
  • ' Position dans l'argument expression où la recherche de sous-chaîne
  • ' doit commencer. Si elle est omise, la position 1 est prise par défaut.
  • ' count (Facultatif)
  • ' Nombre de remplacements de sous-chaîne à effectuer. Si cette valeur
  • ' est omise, la valeur par défaut -1, qui signifie tous les remplacements
  • ' possibles, est employée.
  • ' compare (Facultatif)
  • ' Valeur numérique indiquant le type de comparaison à utiliser lors de
  • ' l'évaluation des sous-chaînes. L'argument compare peut être omis ou
  • ' prendre la valeur 0, ou 1.
  • ' Indiquez la valeur 0 pour effectuer une comparaison binaire.
  • ' Indiquez la valeur 1 pour effectuer une comparaison de texte,
  • ' sans différenciation des majuscules et des minuscules.
  • '
  • ' NOTES : vbDatabaseCompare n'est pas émulé.
  • ' Version: 1.0 - 20/07/2002
  • ' Auteur : Bigane@tiscalinet.ch
  • ' ----------------------------------------------------------------------------
  • Public Function Replace( _
  • ByVal expression As String, _
  • ByVal find As String, _
  • ByVal replacewith As String, _
  • Optional ByVal start As Long = 1, _
  • Optional ByVal count As Long = -1, _
  • Optional ByVal compare As Long)
  • Dim lenFind As Long
  • Dim lenNext As Long
  • Dim lenReplace As Long
  • Dim lenExpression As Long
  • 'Emulation de Const vbUseCompareOption = -1
  • If IsEmpty(compare) Or _
  • ((compare <> vbBinaryCompare) And (compare <> vbTextCompare)) Then
  • compare = IIf("A" = "a", vbTextCompare, vbBinaryCompare)
  • End If
  • If start > Len(expression) Then
  • Replace = vbNullString
  • Else
  • If Not ((start < 1) Or _
  • (start > Len(expression)) Or (find = vbNullString)) Then
  • lenFind = Len(find)
  • lenReplace = Len(replacewith)
  • start = InStr(start, expression, find, compare)
  • Do While (start<>0) And (count<>0)
  • lenExpression = Len(expression)
  • lenNext = start + lenFind
  • expression = Mid$(expression, 1, start - 1) & replacewith & _
  • IIf(lenNext <= lenExpression, _
  • Mid$(expression, lenNext), vbNullString)
  • count = count - 1
  • start = InStr(start + lenReplace, expression, find, compare)
  • Loop
  • End If
  • Replace = expression
  • End If
  • End Function
' ----------------------------------------------------------------------------
' Description
'   Renvoie une chaîne dans laquelle une sous-chaîne spécifiée a été
'   remplacée plusieurs fois par une autre sous-chaîne.
' Syntaxe
'   Replace(expression, find, replacewith[, start[, count[, compare]]])
'
' expression
'   Expression de chaîne contenant une sous-chaîne à remplacer.
' find
'   Sous-chaîne recherchée.
' replacewith 
'   Sous-chaîne de remplacement.
' start (Facultatif)  
'   Position dans l'argument expression où la recherche de sous-chaîne
'   doit commencer. Si elle est omise, la position 1 est prise par défaut.
' count (Facultatif)
'   Nombre de remplacements de sous-chaîne à effectuer. Si cette valeur
'   est omise, la valeur par défaut -1, qui signifie tous les remplacements
'   possibles, est employée.
' compare (Facultatif)
'   Valeur numérique indiquant le type de comparaison à utiliser lors de
'   l'évaluation des sous-chaînes. L'argument compare peut être omis ou
'   prendre la valeur 0, ou 1.
'   Indiquez la valeur 0 pour effectuer une comparaison binaire.
'   Indiquez la valeur 1 pour effectuer une comparaison de texte,
'   sans différenciation des majuscules et des minuscules.
'
' NOTES  :   vbDatabaseCompare n'est pas émulé.
' Version: 1.0 - 20/07/2002
' Auteur :  Bigane@tiscalinet.ch
' ----------------------------------------------------------------------------
Public Function Replace( _
        ByVal expression As String, _
        ByVal find As String, _
        ByVal replacewith As String, _
        Optional ByVal start As Long = 1, _
        Optional ByVal count As Long = -1, _
        Optional ByVal compare As Long)

  Dim lenFind   As Long
  Dim lenNext   As Long
  Dim lenReplace  As Long
  Dim lenExpression As Long
    
  'Emulation de Const vbUseCompareOption = -1
  If IsEmpty(compare) Or _
    ((compare <> vbBinaryCompare) And (compare <> vbTextCompare)) Then
    compare = IIf("A" = "a", vbTextCompare, vbBinaryCompare)
  End If
    
  If start > Len(expression) Then
    Replace = vbNullString
  Else
    If Not ((start < 1) Or _
    (start > Len(expression)) Or (find = vbNullString)) Then
    lenFind = Len(find)
    lenReplace = Len(replacewith)
    start = InStr(start, expression, find, compare)
    Do While (start<>0) And (count<>0)
      lenExpression = Len(expression)
      lenNext = start + lenFind
      expression = Mid$(expression, 1, start - 1) & replacewith & _
        IIf(lenNext <= lenExpression, _
        Mid$(expression, lenNext), vbNullString)
      count = count - 1
      start = InStr(start + lenReplace, expression, find, compare)
      Loop
    End If
    Replace = expression
  End If

End Function
  

 Conclusion

L'émulation est presque identique à l'original, si vous trouvez des bugs ou des différences,
n'hésitez pas...

Historique:
Correction d'un bug le 29-07-2002:
Do While start And count
remplacé par
Do While (start&lt;&gt;0) And (count&lt;&gt;0)

Bigane    


 Sources du même auteur

Source avec Zip Source avec une capture CODER DECODER FICHIER EN BASE-64 POUR TRANSMISSION EN FORMAT...
FORMATER UN PARAGRAPHE ENTRE DEUX MARGES (DROITE ET GAUCHE).
Source avec Zip Source avec une capture COMMENT CRÉER UNE BASE ACCESS, CRÉER TABLE, LIRE COLONNE, EN...

 Sources de la même categorie

Source avec Zip Source avec une capture MASQUE DE SAISIE NUMÉRIQUE par acive
Source avec Zip Source .NET (Dotnet) COMPTEUR DE NOMBRE DE MOTS DANS UN TEXTE par alpha5
Source avec Zip Source avec une capture HM - BLOCNOTE par hassenmajor
Source .NET (Dotnet) [VB.NET] CLASS DE COLORATION SYNTAXIQUE "ON THE FLY" par huzima
Source avec Zip Source avec une capture PERSONNALISEZ VOS BOÎTES DE MESSAGE (X)HTML par medjahedScript

Commentaires et avis

Commentaire de bigane le 20/07/2002 12:47:13

Oups... affichage pourri, je le remet en ligne sur 80 colonnes dans quelques minutes...

Commentaire de bigane le 20/07/2002 12:50:58

Oups... affichage pourri, je le remet en ligne sur 80 colonnes dans quelques minutes...

Commentaire de Alain Proviste le 20/07/2002 21:59:34 administrateur CS

Bon code.

Pour info il existe aussi
http://www.vbfrance.com/article.asp?Val=3008
pour ceux qui utilisent vb5

Commentaire de bigane le 29/07/2002 14:35:08

Le 29-07-2002, j'ai corrigé un bug.
Do While start And count
remplacé par
Do While (start&lt;&gt;0) And (count&lt;&gt;0)

Le source est à jour.

Bigane

Commentaire de jenial le 13/08/2003 10:29:08

Merci bcp,

C trop fort pile poil ce que je cherchais

Commentaire de bigane le 13/08/2003 13:12:04

Fais attention, j'ai remarqué que ce source ne fonctionne pas correctement avec la version Replace() de VB6. J'ai commis une erreur de retranscription, donc tu dois utiliser la fonction replace() que j'ai postée sur vbfrance.
A+

Commentaire de bigane le 12/02/2004 22:02:45

Voici une ligne qu'il faut ajouter en fin de la fonction :

If Start &gt; 1 Then Replace = Mid$(Replace, Start)

J'ai retrouvé cette idée sur un site étranger :
http://www.programmazione.it/index.php?entity=etip&idTip=110&idArea=1

C'est marrant, on a toujours réinventé la roue, sa fonction replace me semble correcte, a voir ...

 Ajouter un commentaire




Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,764 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales