IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo
Sommaire > Exemple de code pour remplacer les fonctions non disponibles d'Access 97
        Code de remplacement la fonction InStrRev
        Code de remplacement de la fonction Replace
        Code de remplacement de la fonction Round
        Code de remplacement de la fonction Split
        Exporter des données vers un fichier XML

rechercher
precedent    sommaire    suivant    telecharger


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 même 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.


Auteur : cafeine
Version : 12/11/2005
Page de l'auteur
Exporter des données vers un fichier XML
Versions : Antérieures à 2002

Cet exemple permet d'exporter une requête ou une table vers un fichier XML en utilisant ADO.

Pour cela vous devez ajouter la référence Microsoft ActiveX Data Object à votre projet.
Public Function xmlXport(ByVal strTableorQuery As String) 

Dim cnx As New ADODB.Connection 
Dim rec As New ADODB.Recordset 

cnx.Provider = "Microsoft.Jet.Oledb.4.0" 
cnx.ConnectionString = CurrentDb.name 

cnx.Open 
rec.Open "SELECT * FROM [" & strTableorQuery & "]", cnx 
    
rec.save "D:\temp\" & strTableorQuery & ".xml", adPersistXML 

rec.Close 
cnx.Close 
Set rec = Nothing 
Set cnx = Nothing 
End Function
Exemple d'utilisation :
xmlXport "MaTable"

rechercher
precedent    sommaire    suivant    telecharger

Valid XHTML 1.1!Valid CSS!

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 © 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.