1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
| Option Explicit
'variables globales
Dim OldNomDico As String 'mémo du dernier dico chargé
Dim DicoStr As String ' variable contenant le dernier dico chargé
Private Sub Form_Load()
Label1.Move 180, 180
Label1.AutoSize = True: Label1.Caption = "Mot ou partie du mot à rechercher"
TextRech.Move 120, 420, 2535, 375
TextRech.Text = ""
Label2.Move 180, 840
Label2.AutoSize = True: Label2.Caption = "ce mot est le/la:"
Option1(0).Move 120, 1080, 1875, 375
Option1(0).Caption = "début ou mot complet": Option1(0).Value = True
Option1(1).Move 2040, 1080, 1575, 375
Option1(1).Caption = "une partie du mot"
Option1(2).Move 3660, 1080, 1095, 375
Option1(2).Caption = "fin du mot"
Command1.Move 120, 1800, 2775, 375: Command1.Caption = "Rechercher la/les occurrences"
Label3.Move 180, 2280
Label3.AutoSize = True: Label3.Caption = "Mot(s) trouvé(s):"
TextTrouver.Move 120, 2580, 4695, 3195
TextTrouver.Text = ""
'TextTrouver.MultiLine = True: TextTrouver.ScrollBars = 2 <------------- à faire en desing ---------
Me.Height = 6465: Me.Width = 5205
End Sub
Private Sub Command1_Click()
TextTrouver.Text = "En cours de recherche ....": TextTrouver.Refresh
TextTrouver.Text = recherchemot(TextRech.Text)
End Sub
Private Function recherchemot(StrMot As String) As String
Dim RegularExpressioN As Object, ResulT As Object, Match As Object
Dim LePattern As String, MsG As String, Cpt As Integer, NomDico As String
If Option1(0).Value = True Then 'début ou mot complet
LePattern = "(" & StrMot & "[\w-zâäàéèùêëîïôöçñ]*)"
Dim Caract As String
Caract = Left(LCase(StrMot), 1)
NomDico = "C:\PersoFrancis\Etude RegExp\" & Caract & ".txt"
'NomDico = "ton chemin plus le nom du dico par lettre.txt"
End If
If Option1(1).Value = True Then 'partie du mot
LePattern = "([\w-zâäàéèùêëîïôöçñ]*" & StrMot & "[\w-zâäàéèùêëîïôöçñ]*)"
NomDico = "C:\PersoFrancis\Etude RegExp\Dico.txt"
'NomDico = "ton chemin plus le nom du dico complet.txt"
End If
If Option1(2).Value = True Then 'fin du mot
LePattern = "([\w-zâäàéèùêëîïôöçñ]*" & StrMot & ")"
NomDico = "C:\PersoFrancis\Etude RegExp\Dico.txt"
'NomDico = "ton chemin plus le nom du dico complet.txt"
End If
If NomDico <> OldNomDico Then
'la recherche se base sur un nouveau dico
OldNomDico = NomDico
DicoStr = ChargeDico(NomDico) ' chargement dans la variable globale du dico approprié
Else
'inutile de recharger le dico dans la variable DicoStr
'puisque la dernière recherche était déjà basée sur le même dico
End If
If InStr(1, DicoStr, "Erreur") Then 'erreur lors du chargement du dico
recherchemot = DicoStr: OldNomDico = "": Exit Function
End If
Set RegularExpressioN = CreateObject("VBScript.RegExp")
RegularExpressioN.Global = True
RegularExpressioN.IgnoreCase = True
RegularExpressioN.Pattern = LePattern
On Error GoTo GestErr
If RegularExpressioN.Test(DicoStr) = True Then 'non obligatoire, méthode Test, permet de déclencher le Else
Set ResulT = RegularExpressioN.Execute(DicoStr)
For Each Match In ResulT
MsG = MsG & "position: " & Match.FirstIndex & _
" Longueur: " & Match.Length & _
" Valeur: " & Match.Value
Cpt = Cpt + 1
If Cpt <> 0 Then MsG = MsG & vbNewLine
Next
MsG = "Nbr.d’occurrence: " & ResulT.Count & vbNewLine & MsG
Set Match = Nothing
Else
MsG = "aucune occurrence trouvée" 'la méthode Test = False
End If
'nettoyage
Set ResulT = Nothing: Set RegularExpressioN = Nothing
recherchemot = MsG
Exit Function
GestErr:
recherchemot = "Erreur n°" & Err.Number _
& "Description:" & vbNewLine & Err.Description
Err.Clear
End Function
Private Function ChargeDico(ChemNomFichier) As String
Dim NumFich As Integer, StrDicoRecup As String, NbrOctet As Long
'chargement sous forme Binary car plus rapide
On Error GoTo GestErr
NumFich = FreeFile
Open ChemNomFichier For Binary As #NumFich
NbrOctet = LOF(NumFich)
StrDicoRecup = Space(NbrOctet)
Get #NumFich, , StrDicoRecup
Close #NumFich
ChargeDico = StrDicoRecup
Exit Function
GestErr:
ChargeDico = "Erreur n°" & Err.Number _
& "Description:" & vbNewLine & Err.Description
Err.Clear
End Function |
Liste ou fichier de mots et synonymes pour exploiter sur vb6
Répondre avec citation
Balises[CODE]...[/CODE]
en fin de discussion, quand vous avez obtenu l'aide attendue.
......... et pourquoi pas, pour remercier, un 
pour celui/ceux qui vous ont dépannés.
Si tu parviens à utiliser ce programme et avoir le résultat attendu, je t'aiderais à inclure la partie code dans ton propre code.
Partager