Ce tutoriel est une partie de : celui-ci.
Le but ici est de créer un dictionnaire, au format texte (extension .txt), composé d'un mot par ligne, à partir de listes de mots trouvées sur Internet. Inutile de refaire ce qui a été très bien fait par Qwazerty, il s'agit ici d'appliquer les connaissances acquises lors de la lecture de ce tutoriel, c'est-à-dire :
Pour réaliser notre dictionnaire, nous nous baserons sur les mots répertoriés dans le site Internet : http://www.liste-de-mots.com/
Pour manipuler Internet Explorer depuis VBA sous Excel, il est nécessaire d'activer les références suivantes :
Depuis votre éditeur VBE, Outils/Références, cherchez puis cochez les cases correspondantes à ces deux références.
Nous allons ici utiliser une macro afin d'extraire les mots nous intéressants depuis le site référencé ci-dessus. Pour cela, nous allons utiliser une méthode permettant de manipuler Internet Explorer depuis Excel, via VBA.
Afin d'extraire des données situées sur Internet, il nous faut connaitre certaines notions de base du langage html. Les données textuelles sont, en html, placées dans des balises. Il en existe plusieurs que nous ne détaillerons pas ici. Cependant, toutes ces balises ont la possibilité (si le site est bien fait ce sera le cas), d'être identifiées grâce à des « id » ou grâce à des « class ». Nous voyons ici lien msdn les différentes méthodes utilisables avec l'objet HtmlDocument.
Allons faire un tour sur notre site Internet, et regardons notamment le code-source de cette page (mots de 3 lettres commençant par la lettre A) : http://www.liste-de-mots.com/mots-nombre-lettre/3/a/. L'analyse du code source nous montre que la liste des mots de 3 lettres commençant par « A » est stockée dans une balise p (pour information la balise <p></p> est utilisée en HTML pour délimiter un paragraphe), affublée d'une class nommée "liste-mots" :
<p class="liste-mots"> ace, agi, aie, ail, air, ais, ait, ale, alu, ami, ana, and, api, apr, ara, arc, are, ars, art, aux, avr, axa, axe, axé, aïs, âge, âgé, âme, âne</p>
La récupération des mots de cette liste, se fera selon les étapes suivantes :
Voici donc les codes nécessaires :
La boucle :
Nota : Il est possible, selon les configurations, que la mémoire soit insuffisante pour boucler sur toutes les lettres des mots de longueurs 3 à 16 caractères. Pour éviter cela, nous allons instancier un nouvel objet Internet Explorer à chaque boucle sur la longueur des mots. Cette variable sera systématiquement détruite en fin de chacune de ces boucles.
Option Explicit '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 'Activer les 2 références : Microsoft Internet Controls et Microsoft HTML Object Library ' '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'De plus amples informations au tutoriel : 'http://qwazerty.developpez.com/tutoriels/vba/ie-et-vba-excel/ Dim IE As New InternetExplorer Dim Liste() As String Dim Cpt As Integer Sub Principale_LaBoucle() Dim StrLien As String, Lettre As String, i As Integer, j As Integer Dim t As Single t = Timer 'Chargement initial de la page web "générique" IE.Navigate "http://www.liste-de-mots.com/mots-nombre-lettre/" 'Affichage de la fenêtre IE IE.Visible = True Do Until IE.ReadyState = READYSTATE_COMPLETE 'DoEvents Loop For i = 3 To 16 For j = 1 To 26 Lettre = Chr(96 + j) StrLien = "http://www.liste-de-mots.com/mots-nombre-lettre/" & i & "/" & Lettre & "/" ImporterMotsDepuisInternet StrLien Next j Next i IE.Quit 'On libère la variable IE Set IE = Nothing 'A ce stade nous avons récupéré les données du site 'dans la variable tableau Liste() MsgBox UBound(Liste) & " " & Timer - t End Sub
La procédure liée à cette boucle :
Sub ImporterMotsDepuisInternet(Lien As String) Dim IEDoc As HTMLDocument Dim ColBalisesP As IHTMLElementCollection Dim Elem As HTMLGenericElement IE.Navigate Lien Do Until IE.ReadyState = READYSTATE_COMPLETE Loop 'On pointe le membre Document Set IEDoc = IE.document 'On enregistre la collection de balises p Set ColBalisesP = IEDoc.getElementsByTagName("p") 'On boucle sur chaque élément de cette collection For Each Elem In ColBalisesP 'Si la class de cet élément est nommée "liste-mots" If Elem.className = "liste-mots" Then 'S'il n'existe aucun mot de x lettres commençant par la lettre en cours If Left(Elem.innerText, 23) <> "Aucun mot ne correspond" Then ReDim Preserve Liste(Cpt) Liste(Cpt) = Elem.innerText Cpt = Cpt + 1 Exit For End If End If Next End Sub
L'analyse des éléments de notre liste nous indique que les données recueillies sont de la forme :
Liste(x) = "mot1, mot2, môt3, mot-4, m-öt5"
Puisque nous souhaitons obtenir un dictionnaire comportant un mot par ligne, il va nous falloir :
Vont donc changer, dans le code de déclaration des variables :
Ajout de la variable tableau ListeMots() :
Option Explicit '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' 'Activer les 2 références : Microsoft Internet Controls et Microsoft HTML Object Library ' '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 'De plus amples informations au tutoriel : 'http://qwazerty.developpez.com/tutoriels/vba/ie-et-vba-excel/ Dim IE As New InternetExplorer Dim Liste() As String, ListeMots() As String Dim Cpt As Integer
Dans le code de la boucle :
Depuis la procédure de boucle, nous allons appeler une autre procédure que nous nommerons Traitement. Cette procédure traitera les données. Elle est appelée après que la boucle soit terminée, soit :
Sub Principale_LaBoucle() Dim StrLien As String, Lettre As String, i As Integer, j As Integer Dim t As Single 'Je n'ai pas remis tout le code, c'est inutile il est ci-dessus 'On libère la variable IE Set IE = Nothing 'A ce stade nous avons récupéré les données du site 'dans la variable tableau Liste() Traitement '? Appel de la procédure de traitement des données MsgBox UBound(Liste) & " " & Timer - t End Sub
Ce code devra donc :
Pour scinder les éléments de notre liste, nous allons utiliser la fonction Split (de plus amples informations sur cette fonction ICI. Cette fonction retourne un tableau à une dimension de base zéro et contenant le nombre spécifié de sous-chaînes.
Par contre, il nous est impossible de savoir combien de mots sont stockés dans chacun des éléments de Liste().
Pour cela, nous allons avoir besoin d'une autre fonction de Visual Basic : UBound cf ICI. Celle-ci retourne le plus grand indice disponible pour la dimension indiquée d'un tableau. La fonction Split retournant un tableau à une dimension, il suffira d'appliquer UBound à Split pour obtenir le nombre de mots contenus dans Liste(x), comme ceci :
UBound(Split(Liste(i), ",")) = nombre total de mots dans Liste(i)
Sub Traitement() Dim i As Long, j As Long, k As Long 'Boucle sur tous les éléments de Liste() For i = LBound(Liste) To UBound(Liste) For j = 0 To UBound(Split(Liste(i), ",")) ReDim Preserve ListeMots(k) ListeMots(k) = Split(Liste(i), ",")(j) k = k + 1 Next j Next i End Sub
Nous allons réaliser ces deux traitements, simultanément, en même temps que le stockage des mots dans la variable ListeMots. Rien de particulier, si ce n'est l'utilisation des deux fonctions :
La ligne :
ListeMots(k) = Split(Liste(i), ",")(j)
Devient donc :
ListeMots(k) = UCase(Trim(Split(Liste(i), ",")(j)))
Profitons-en également pour enlever les traits d'union. Une autre fonction de Visual Basic nous attend pour cela : la fonction Replace. Celle-ci retourne une chaîne dans laquelle une sous-chaîne spécifiée a été remplacée par une autre sous-chaîne. Ici nous voulons supprimer les "-", donc les remplacer par rien. La syntaxe de Replace est donc : Replace(monmot, "-", ""). Soit :
ListeMots(k) = Replace(UCase(Trim(Split(Liste(i), ",")(j))), "-", "")
Nota : On aurait pu continuer la boucle et importer les mots de 17 lettres comportant un tiret ainsi que les mots de 18 lettres comportant deux tirets.
Aucune fonction Visual Basic, à ma connaissance, ne fait ce traitement. Nous avons plusieurs choix, j'ai pris le parti d'utiliser celle-ci, qui me semble être la plus simple :
Function EnleveLesAccents(ByVal MonMot As String) As String Dim i As Integer 'On définit dans 2 constantes les caractères accentués Const CaracteresAvecAccents As String = "ÁÂÄÇÈÉÊËÎÏÒÓÔÖÙÚÛÜ" 'et leur équivalant sans accent Const CaracteresSansAccents As String = "AAACEEEEIIOOOOUUUU" 'Boucle sur toutes les lettres de notre mot For i = 1 To Len(MonMot) 'Si la lettre est accentuée If InStr(CaracteresAvecAccents, Mid(MonMot, i, 1)) > 0 Then 'On la remplace Mid(MonMot, i, 1) = Mid(CaracteresSansAccents, InStr(CaracteresAvecAccents, Mid(MonMot, i, 1)), 1) End If Next i EnleveLesAccents = MonMot End Function
On appellera cette fonction personnalisée, depuis notre procédure traitement, comme ceci :
Sub Traitement() Dim i As Long, j As Long, k As Long For i = LBound(Liste) To UBound(Liste) For j = 0 To UBound(Split(Liste(i), ",")) ReDim Preserve ListeMots(k) 'traitement des majuscules, des espaces, des virgules : ListeMots(k) = UCase(Trim(Split(Liste(i), ",")(j))) 'Traitement des accents ListeMots(k) = EnleveLesAccents(ListeMots(k)) k = k + 1 Next j Next i End Sub
Ceci n'étant pas le but premier de ce tutoriel, nous nous contenterons d'utiliser le code créé par Jacques Boisgontier, disponible à cette adresse : http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#AlimenterListe
Sub tri(a, gauc, droi) ' Quick sort 'http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm#AlimenterListe Dim ref, g, d, temp ref = a((gauc + droi) \ 2) g = gauc: d = droi Do Do While a(g) < ref: g = g + 1: Loop Do While ref < a(d): d = d - 1: Loop If g <= d Then temp = a(g): a(g) = a(d): a(d) = temp g = g + 1: d = d - 1 End If Loop While g <= d If g < droi Then Call tri(a, g, droi) If gauc < d Then Call tri(a, gauc, d) End Sub
Code que nous appellerons depuis la procédure de boucle, après l'appel du Traitement, comme ceci :
Call tri(ListeMots, LBound(ListeMots), UBound(ListeMots))
Cette méthode de tri est la plus rapide. Pour info, le tri alphabétique de 39720 mots a duré 13 secondes sur mon pc.
Vous pouvez maintenant écrire le contenu de la variable ListeMots() dans un fichier texte. Vous trouverez ici [lien vers tutoriel Lecture, Modification et Enregistrement d'un fichier txt] la description de cette méthode.
Le code, à ajouter après l'appel de Traitement dans la procédure de boucle est :
'Ecriture dans un fichier texte : Dim num As Long, Chemin As String, Cptr As Long num = FreeFile Chemin = ThisWorkbook.Path 'Ouvre en écriture et écrase un fichier précédent du même nom Open Chemin & "\ MonDictionnairePerso.txt " For Output As #num 'Boucle sur la liste des mots For Cptr = LBound(ListeMots) To UBound(ListeMots) 'Ecrit dans le fichier texte ligne par ligne Print #1, ListeMots(Cptr) Next Cptr 'Fermeture Close #num
Toute cette procédure d'importation de données depuis Internet se faisant par une double-boucle, en manipulant un Objet assez lourd en utilisation de mémoire, le résultat étant relativement important, vous risquez de rencontrer des problèmes de durée (macro très longue) et d'insuffisance de mémoire. Si tel est le cas, scindez votre procédure de boucle en plusieurs étapes en modifiant :
For i = 3 To 16
Par étape, vous pouvez faire comme ceci :
For i = 3 To 3 For i = 4 To 4 '... For i = 16 To 16
N'oubliez pas de stocker les valeurs contenues dans ListeMots au fur et à mesure...
Pour information, l'importation des mots de 3 à 16 lettres commençant uniquement par les lettres A et B a donné, sur mon pc, un dictionnaire de 39 720 mots en 1 minute et 37 secondes...
Le dictionnaire texte que vous pourrez créer de cette manière comportera, en tout et pour tout, 323 782 mots de 3 à 16 lettres.
Vous trouverez ci-joint le classeur Excel contenant tous les codes détaillés ici : http://cjoint.com/?DHfkTHD8FSx
Ce tutoriel est un complément de : celui-ci. Vous pourrez y trouver un exemple d'utilisation.