IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)



Auteur : Tofalu
Version : 05/03/2005
Page de l'auteur
Code de remplacement la fonction InStrRev
Version : 97 principalement

Function TInstrRev(Texte As String, cherche As String, _ Optional Start As Integer = 0, _ Optional Comparaison As integer= vbTextCompare) _ As Integer On Error GoTo err If Start < 1 Then Start = Len(Texte) Texte = Right(Texte, Start) While InStr(TInstrRev + 1, Texte, cherche, Comparaison) > 0 TInstrRev = InStr(TInstrRev + 1, Texte, cherche, Comparaison) Wend Exit Function err: MsgBox "Vérifier vos paramètres", vbCritical, "Fonction TInstrRev" End Function
Utilisation :

MsgBox TInstrRev("Toto", "to", 2)
Cet exemple affichera : 1


Auteur : Shwin
Version : 28/01/2005
Code de remplacement de la fonction Replace
Versions : 97 principalement

Public Function ReplaceT(ByVal Expression As String, _ ByVal Find As String, _ ByVal Replace As String, _ Optional ByVal Start As Long = 1, _ Optional ByVal Count As Long = -1, _ Optional ByVal Compare As Integer = vbTextCompare) _ As String Dim P As Long ' position 1er caractère à tester Dim L As Long ' longueur de expression Dim f As Long ' longueur de la chaîne à remplacer Dim r As Long ' longueur chaîne de remplacement ' argument "Start" : élimination du début de chaîne Let L = Len(Expression) If Start > L Then ' parceque "Right$" n'accepte pas 1 taille négative Let Expression = vbNullString ElseIf Start > 1 Then ' troncature d'"Expression" Let Expression = Right$(Expression, L - Start + 1) End If ReplaceT = Expression ' valeur retour par défaut ' argument "Find" : si chaîne vide, on retourne "Expression". If Find = vbNullString Then Exit Function Let f = Len(Find) Let r = Len(Replace) ' Taille de la chaîne de remplacement Let P = 1 ' on commence à la première position If Count <> 0 Then Do ' La taille d'"Expression" peut varier lors de chaque ' remplacement (si "Find" et "Replace" sont de longueurs ' différentes), c'est pourquoi l'instruction suivante ' est située DANS la boucle. Let L = Len(Expression) ' position de la sous-chaîne à remplacer... Let P = InStr(P, Expression, Find, Compare) ' ... si elle y figure bien If P > 0 Then Let Expression = Left$(Expression, P - 1) + _ Replace + _ Right$(Expression, (L - P - f + 1)) ' décalage 1er caractère à comparer (position trouvée ' + taille de la chaîne de remplacement) Let P = P + r ' Un remplacement de moins à effectuer (si "Count">0) ' on continue indéfiniment si "Count" < 0 Let Count = Count - 1 End If ' Si le compteur atteint zéro (cas où on voulait un nombre ' défini de substitutions), où s'il n'y a plus de ' remplacements possibles, on sort. Loop Until (P <= 0) Or (Count = 0) End If ReplaceT = Expression ' retour.. End Function

Auteur : extros
Version : 28/01/2005
Code de remplacement de la fonction Round
Versions : 97 principalement

Voici une fonction d'arrondi (spécialement utile pour la comptabilité) :
Parfois, certaines fonctions arrondissent 0,4450 a 0,44 au lieu de 0,45 comme c'est nécessaire parfois en comptabilité. Avec celle-ci, il est meme possible de choisir le chiffre qui induit un arrondi supérieur.

Function RoundCost(ByVal Nbr As Double, Optional ByVal Expo As Long = 2, _ Optional ByVal NextNumSup = 5) As Double 'Expo is the number of desired decimals 'NextNumSup is the min number after the Expo decimal which result in a Roundsup for Nbr 'Exemple : Roundcost(0.44X) = 0.45 if X >= NextNumSUp (5 by default) 'Correct bug for RoundSup(0.445) = 0.44 If Expo < 0 Then RoundCost = RoundCost(Nbr * 10 ^ Expo, Abs(Expo)) RoundCost = CLng(Nbr * 10 ^ Expo + (0.01 * (10 - NextNumSup))) / 10 ^ Expo End Function

Auteur : Tofalu
Version : 28/01/2005
Page de l'auteur
Code de remplacement de la fonction Split
Versions : 97 principalement

Public Function FctSplit(ByVal strg As String, Sep As String) As Variant Dim i As Integer Dim TblSplit() As String i = 1 While InStr(1, strg, Sep) <> 0 ReDim Preserve TblSplit(i) TblSplit(i - 1) = Left(strg, InStr(1, strg, Sep) - 1) strg = Mid(strg, InStr(1, strg, Sep) + Len(Sep)) i = i + 1 Wend If Len(strg) > 0 Then ReDim Preserve TblSplit(i) TblSplit(i - 1) = strg End If FctSplit = TblSplit End Function
Utilisation :

Dim T() as string T=FctSplit("Bonjour Monsieur Dupont"," ")
Ce code renvoit un tableau contenant chaque mot de la phrase passée en paramètre.



Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2004-2005 Maxence Hubiche Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.