Accueil > > > 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
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
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
ASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHEASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHE par fathi
Tout le monde est unanime pour dire que la programmation multi-thread et asynchrone est en train de devenir un sujet incontournable. Beaucoup de choses sont arrivées avec le framework 4 pour le code parallèle (TPL, PLinq,.) et bientôt, on va avoir l...
Cliquez pour lire la suite de l'article par fathi PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS !PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS ! par Etienne Margraff
J'ai récemment eu un problème pour obtenir l'intelliTrace sur un site web dans IIS. Il n'y avait pas de message d'erreur, rien dans le journal d'évènement Windows, et après 3 appels à une voyante, 2 visites chez un marabou, j'ai failli me résign...
Cliquez pour lire la suite de l'article par Etienne Margraff OFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONSOFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONS par junarnoalg
De nombreuses entreprises font le choix de SharePoint Online, service fourni au travers de l'offre de Microsoft Office 365. S'il est vrai que ce choix apporte un grand nombre d'avantages; rapidité de mise en œuvre, disponibilité, large couvertu...
Cliquez pour lire la suite de l'article par junarnoalg PRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGEPRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGE par richardc
http://www.c2idotnet.com/articles/presentation-des-api-rest-de-windows-azure-lister-les-comptes-de-storage
Désolé pour "toto", mais c2i existait avant blogs.developpeur.org et c'est mon site "officiel" ;-) ...
Cliquez pour lire la suite de l'article par richardc
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|