begin process at 2012 02 17 08:46:31
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Texte

 > FONCTION REPLACE POUR ACCESS 97 AUSSI PERFORMANTE QUE REPLACE DE VB

FONCTION REPLACE POUR ACCESS 97 AUSSI PERFORMANTE QUE REPLACE DE VB


 Information sur la source

Note :
Aucune note
Catégorie :Texte Niveau :Débutant Date de création :19/04/2003 Date de mise à jour :19/04/2003 08:43:03 Vu / téléchargé :9 315 / 274

Auteur : VicoLaChips2

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

 Description

Ayant eu à convertir une BD Access 2000 en access 97 je me suis rendu compte que la fonction replace n'existait pas... d'ou ce source !

@+

Source

  • 'Ayant eu à convertir un appli access 2000
  • 'en access 97 je me suis aperçu que la fonction
  • 'replace dans access 97 n'était pas prise en charge
  • '-----------
  • 'voici le code qui test ma fonction
  • '-------------------
  • '@+, VIC
  • Option Explicit
  • '--------------
  • Private Declare Function GetTickCount Lib "kernel32" () As Long
  • Private Sub btnOpen_Click()
  • Dim sTmp As String, sText As String
  • With Cdlg
  • .Filter = "Texte (*.txt)|*.txt"
  • .InitDir = App.Path
  • .ShowOpen
  • If .FileName <> "" Then
  • Open .FileName For Input As #1
  • Do While Not EOF(1)
  • Line Input #1, sTmp
  • sText = sText & sTmp
  • Loop
  • txtSource.Text = sText
  • Close #1
  • txtResult = ""
  • End If
  • End With
  • End Sub
  • Private Sub btnVbReplace_Click()
  • Dim lngSTime As Long, lngETime As Long
  • If Len(txtSource) = 0 Then
  • MsgBox "choisir un fichier", vbCritical, "Pas de fichier sélectionné"
  • Exit Sub
  • End If
  • ' ----
  • lngSTime = GetTickCount()
  • txtResult = Replace(txtSource, txtRemplaceSA, txtParSA)
  • lngETime = GetTickCount()
  • lblVbResult = lngETime - lngSTime
  • End Sub
  • Private Sub btnVicoReplace_Click()
  • Dim lngSTime As Long, lngETime As Long
  • If Len(txtSource) = 0 Then
  • MsgBox "choisir un fichier", vbCritical, "Pas de fichier sélectionné"
  • Exit Sub
  • End If
  • ' ----
  • lngSTime = GetTickCount()
  • txtResult = ReplaceItem(txtSource, txtRemplaceSA, txtParSA)
  • lngETime = GetTickCount()
  • lblVicoResult = lngETime - lngSTime
  • End Sub
  • Private Function ReplaceItem(ByVal sItem As String, _
  • ByVal sFindString As String, _
  • ByVal sReplaceString As String) As String
  • ' ----
  • If InStr(sItem, sFindString) = 0 Then
  • ReplaceItem = sItem: Exit Function
  • End If
  • ' ----
  • Dim iPos As Long, sTmp As String
  • iPos = 1
  • Do
  • iPos = InStr(iPos, sItem, sFindString)
  • If iPos > 0 Then
  • Mid(sItem, iPos, 1) = sReplaceString
  • Else
  • Exit Do
  • End If
  • Loop
  • ' ----
  • ReplaceItem = sItem
  • End Function
'Ayant eu à convertir un appli access 2000
'en access 97 je me suis aperçu que la fonction
'replace dans access 97 n'était pas prise en charge
'-----------
'voici le code qui test ma fonction
'-------------------


'@+, VIC

Option Explicit
'--------------
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub btnOpen_Click()
    Dim sTmp As String, sText As String
    With Cdlg
        .Filter = "Texte (*.txt)|*.txt"
        .InitDir = App.Path
        .ShowOpen
        If .FileName <> "" Then
            Open .FileName For Input As #1
            Do While Not EOF(1)
                Line Input #1, sTmp
                sText = sText & sTmp
            Loop
            txtSource.Text = sText
            Close #1
            txtResult = ""
        End If
    End With
    
End Sub

Private Sub btnVbReplace_Click()
    Dim lngSTime As Long, lngETime As Long
    If Len(txtSource) = 0 Then
        MsgBox "choisir un fichier", vbCritical, "Pas de fichier sélectionné"
        Exit Sub
    End If
    ' ----
    lngSTime = GetTickCount()
    txtResult = Replace(txtSource, txtRemplaceSA, txtParSA)
    lngETime = GetTickCount()
    lblVbResult = lngETime - lngSTime
End Sub

Private Sub btnVicoReplace_Click()
    Dim lngSTime As Long, lngETime As Long
    If Len(txtSource) = 0 Then
        MsgBox "choisir un fichier", vbCritical, "Pas de fichier sélectionné"
        Exit Sub
    End If
    ' ----
    lngSTime = GetTickCount()
    txtResult = ReplaceItem(txtSource, txtRemplaceSA, txtParSA)
    lngETime = GetTickCount()
    lblVicoResult = lngETime - lngSTime
End Sub

Private Function ReplaceItem(ByVal sItem As String, _
                            ByVal sFindString As String, _
                            ByVal sReplaceString As String) As String
                            
    ' ----
    If InStr(sItem, sFindString) = 0 Then
        ReplaceItem = sItem: Exit Function
    End If
    ' ----
    
    Dim iPos As Long, sTmp As String
    iPos = 1
    
    Do
        iPos = InStr(iPos, sItem, sFindString)
        If iPos > 0 Then
            Mid(sItem, iPos, 1) = sReplaceString
        Else
            Exit Do
        End If
    Loop
    ' ----
    ReplaceItem = sItem
End Function



 Conclusion

Voir le zip

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip UN DATASET SOUS VB6
Source avec Zip Source avec une capture MASQUE DE SAISIE DATE QUI AFFICHE LE MASQUE.
MACROS EXCEL POUR LES FICHIERS CSV
Source avec Zip TEMPS PENDANT LEQUEL L'ORDINATEUR EST ALLUMÉ.
Source avec Zip Source avec une capture CODE SOURCE VB &GT;&GT; HTML

 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

Aucun commentaire pour le moment.

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

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 : 2,746 sec (3)

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