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

MsgBox TInstrRev("Toto", "to", 2)

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

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

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

Dim T() as string
T=FctSplit("Bonjour Monsieur Dupont"," ")

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

xmlXport "MaTable"