Page 1 sur 1

ReplaceSubString

MessagePublié: 26 Déc 2004 à 01:04
par oguruma
@ReplaceSubString en LS
Une version parmi tant d'autres

Function replaceSubString(tmpString As String, oldString As String, newString As Variant, onServer As Integer) As Integer

Dim position As Integer
Dim lenOldString As Integer


On Error Goto handleError

'// Pour éviter un plantage si l'origine est NULL
If tmpString = "" Then
replaceSubString = True
Exit Function
End If

'// Recherche de la première occurence de la chaine à remplacer
lenOldString = Len(oldString)

position = Instr(tmpString, oldString)

'// et tant que la chaine n'est pas entièrment remplacée

Do While position > 0 And oldString <> ""
'// recontruit la chaine avec sa nouvelle valeur de sous-chaine
tmpString = Left(tmpString, position - 1) & newString & Mid(tmpString, position + lenOldString)
position = Instr(position + Len(newString), tmpString, oldString)
Loop


'// Remplacement effectué
replaceSubString = True

Exit Function
handleError:
Msgbox "Erreur n° " & Err & " : " & Error$ & " ligne " & Erl,16,"replaceSubstring"
fin:
End Function

MessagePublié: 29 Juil 2005 à 12:12
par Michael DELIQUE
Salut

Une autre version

Code : Tout sélectionner
Function ReplaceSubstring_LS (Byval wSource As String, Byval wTarget As String, Byval wReplace As String) As String
   
   'Déclaration des Variables
   Dim nbTargetLen As Long
   Dim nbReplaceLen As Long
   Dim nbNextPos As Long
   
   On Error Goto ErreurReplaceSubstring_LS   
   
   If wSource = "" Then
      ReplaceSubstring_LS = ""
      Exit Function
   End If
   If wTarget = "" Then
      ReplaceSubstring_LS = ""
      Exit Function
   End If
   
' Make copy of SourceString
   ReplaceSubstring_LS = wSource
' Calculate the Original SubString and Replacement SubString lengths only once:
   nbTargetLen = Len(wTarget)
   nbReplaceLen = Len(wReplace)
' Find First SubString to Replace
   nbNextPos = Instr( ReplaceSubstring_LS, wTarget)
   
' Loop searching for substrings to replace
   Do Until nbNextPos = 0
' Replace substring with new substring
      ReplaceSubstring_LS = Left$( ReplaceSubstring_LS, nbNextPos-1) + wReplace + Mid$( ReplaceSubstring_LS, nbNextPos + nbTargetLen )
      
' Find the next substring to replace
      nbNextPos = Instr(nbNextPos+nbReplaceLen,  ReplaceSubstring_LS, wTarget)
   Loop
   
   Exit Function
   
ErreurReplaceSubstring_LS:
   Msgbox "(ReplaceSubstring_LS) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   ReplaceSubString_LS = ""
   Exit Function
End Function

MessagePublié: 16 Déc 2006 à 20:05
par oguruma
j'ai qu'en V6 il y a la fonction Replace désormais
je l'ai utilisé.. ça fonctionne bien
au lieu de passe une chaine on passe un tableau