Discussion :

[TGO77]

Bonjour,

j'ai une macro qui me permet en chargeant un dictionnaire en mémoire, de définir si un texte est écrit en anglais ou en français.
Le test donne vrai si français et faux si anglais.

j'aurai besoin de votre aide car je souhaiterai rajouter dans cette macro un test supplémentaire : si faux alors vérifier dans le texte "faux" la présence des mots bonjour et/ou merci et/ou cordialement.
Si au moins un des trois mots est présent alors faux devient vrai

merci pour votre aide

ci-dessous la macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function CheckFrench(ByVal pTexte As String) As Boolean
Dim lTexte As String
Dim lTempWord As String
Dim i As Long
Dim lCountFrench As Long
Dim TabWord
 
On Error GoTo err_check
 
'Remplit le dictionnaire des mots francais
Call Fill_French_Dictionnary
 
lTexte = LCase(pTexte)
'Remplace par des espaces
lTexte = Replace(lTexte, ",", " ")
lTexte = Replace(lTexte, ".", " ")
lTexte = Replace(lTexte, "-", " ")
lTexte = Replace(lTexte, "_", " ")
lTexte = Replace(lTexte, "?", " ")
lTexte = Replace(lTexte, "!", " ")
lTexte = Replace(lTexte, "(", " ")
lTexte = Replace(lTexte, ")", " ")
lTexte = Replace(lTexte, ":", " ")
lTexte = Replace(lTexte, ";", " ")
 
 
'Enleve
lTexte = Replace(lTexte, "=", "")
lTexte = Replace(lTexte, "#", "")
lTexte = Replace(lTexte, "*", "")
lTexte = Replace(lTexte, "@", "")
 
'On enleve les chiffres
lTexte = Replace(lTexte, "0", "")
lTexte = Replace(lTexte, "1", "")
lTexte = Replace(lTexte, "2", "")
lTexte = Replace(lTexte, "3", "")
lTexte = Replace(lTexte, "4", "")
lTexte = Replace(lTexte, "5", "")
lTexte = Replace(lTexte, "6", "")
lTexte = Replace(lTexte, "7", "")
lTexte = Replace(lTexte, "8", "")
lTexte = Replace(lTexte, "9", "")
lTexte = Replace(lTexte, "/", "")
lTexte = Replace(lTexte, "\", "")
 
'Remplace les doubles/triples/quadriples espaces par des simples
lTexte = Replace(lTexte, " ", " ")
lTexte = Replace(lTexte, " ", " ")
lTexte = Replace(lTexte, " ", " ")
 
 
'On utilise les espaces comme separation entre les mots (creation du tableau des mots)
TabWord = Split(lTexte, " ")
'Boucle sur les mots
For i = 0 To UBound(TabWord)
If m_DictFrench.Exists(Replace(TabWord(i), " ", "")) = True Then
lCountFrench = lCountFrench + 1
End If
Next
 
If UBound(TabWord) <> 0 Then
'Degre de confiance de 0.4 (40% des mots trouve sont des mots francais)
If lCountFrench / UBound(TabWord) > 0.4 Then
CheckFrench = True
Else
CheckFrench = False
End If
End If
 
Exit Function
err_check:
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Fill_French_Dictionnary()
Dim MyWord As String
 
On Error GoTo err_dict
 
If Not m_DictFrench Is Nothing Then
Exit Sub
Else
Set m_DictFrench = New Scripting.Dictionary
'
'Open m_DictFrenchLocation For Input As #1 ' Open file for input.
 
'Do While Not EOF(1) ' Loop until end of file.
' Input #1, MyWord ' Read data into two variables.
' Debug.Print MyWord ' Print data to the Immediate window.
'Loop
'Close #1 ' Close file.
 
Dim oFSO As New FileSystemObject
Dim oFS
 
Set oFS = oFSO.OpenTextFile(m_DictFrenchLocation)
 
Do Until oFS.AtEndOfStream
MyWord = oFS.ReadLine
'Debug.Print MyWord
m_DictFrench.Add MyWord, ""
Loop
End If
 
Exit Sub
err_dict:
MsgBox "Erreur lors de la lecture/remplissage du dictionnaire francais"
End Sub

[Fvandermeulen]

Salut et bienvenue,
La méthode .Find devrait faire l'affaire, voici un exemple, je te laisse le placer au bon endroit et adapter à ton cas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Set PlageDate = Sheets("Tafeuille").Range("TaPlage") 'On défini la plage qui contient les infos
    With PlageDate
        Set MaRech = .Find("Bonjour", LookIn:=xlValues) 'On effectue la recherche du mot bonjour et récupère l'adresse de la cellule correspondante
    If Not MaRech Is Nothing Then
        MsgBox "Le mot Bonjour est présent" 'Action si trouvé
    End If
    End With

A+

Edit: Supression de la remarque sur les balises car OK entretemps