Sub LireDicoFirefox() Dim Tb() As String, Chemin As String, num As Long, i As Long Chemin = ThisWorkbook.Path NomFicTxt = "\DicoFirefoxFrancais.txt" 'permet de retrouver le 1er numéro libre de désignation d'un fichier num = FreeFile 'ouvre le fichier en lecture Open Chemin & NomFicTxt For Input As #num i = -1 'boucle tant que l'on n'a pas atteint la fin du fichier While Not EOF(1) '***************Stockage des lignes dans la variable tableau Tb i = i + 1 ReDim Preserve Tb(i) Line Input #1, Tb(i) Wend Close #num 'fermeture End Sub
'Cette fonction remplace les caractères spéciaux 'contenus dans le dictionnaire firefox Function RemplaceCarSpec(monMot As String) Dim motTemp As String 'La méthode utilisée ici est : Replace (cf aide VBA à ce sujet) motTemp = Replace(monMot, "é", "e") motTemp = Replace(motTemp, "ï", "i") motTemp = Replace(motTemp, "è", "e") motTemp = Replace(motTemp, "-", "") motTemp = Replace(motTemp, "ç", "c") motTemp = Replace(motTemp, "ë", "e") motTemp = Replace(motTemp, "ê", "e") motTemp = Replace(motTemp, "ü", "u") motTemp = Replace(motTemp, "â", "a") motTemp = Replace(motTemp, "ä", "ae") motTemp = Replace(motTemp, "ô", "o") motTemp = Replace(motTemp, "ÿ", "y") motTemp = Replace(motTemp, "î", "i") motTemp = Replace(motTemp, "Å""", "oe") motTemp = Replace(motTemp, "û", "u") motTemp = Replace(motTemp, "æ", "ae") motTemp = Replace(motTemp, "Ã¥", "a") motTemp = Replace(motTemp, "ö", "o") motTemp = Replace(motTemp, "Ã", "a") motTemp = Replace(motTemp, "É", "e") motTemp = Replace(motTemp, "È", "e") motTemp = Replace(motTemp, "Ã...", "a") motTemp = Replace(motTemp, "Å'", "oe") motTemp = Replace(motTemp, "Å"", "oe") 'Transforme notre chaîne de caractères en Majuscules RemplaceCarSpec = UCase(motTemp) End Function
'Cette fonction va stocker les mots ne contenant pas de chiffres 'en début ou en fin de chaîne (ex : supprime 2ND) 'Sa particularité est qu'on lui passe en paramètre une variable tableau 'et qu'elle renvoie une variable tableau Function Affine(Tbl) Dim TbTemp(), i As Long, CptTbNum As Long, CptTemp As Long For i = LBound(Tbl) To UBound(Tbl) If Len(Tbl(i)) > 2 And Len(Tbl(i)) < 17 Then If Not IsNumeric(Right(Tbl(i), 1)) And Not IsNumeric(Left(Tbl(i), 1)) Then ReDim Preserve TbTemp(CptTemp) TbTemp(CptTemp) = Tbl(i) CptTemp = CptTemp + 1 End If End If Next i Affine = TbTemp End Function
Dim PremierJet() As String 'Tb(0) car le dictionnaire firefox ne contient qu'une ligne 'Dans le cas contraire il eut fallu boucler PremierJet = Split(Tb(0), "/") For i = LBound(PremierJet) To UBound(PremierJet) PremierJet(i) = Split(PremierJet(i), Chr(9))(1) PremierJet(i) = Split(PremierJet(i), Chr(10))(1) Next i
num = FreeFile 'Ouvre en écriture et écrase un fichier précédent du même nom Open Chemin & "\DicoFirefoxFrancaisTransforme.txt" For Output As #num 'Boucle sur la liste des mots For i = LBound(ListeMots) To UBound(ListeMots) 'Ecrit dans le fichier texte ligne par ligne Print #1, ListeMots(i) Next i 'Fermeture Close #num
Avis de décès, Carte de voeux, Bricolage, Coloriages, Cinéma, Coiffure, Cuisine, Déco, Dictionnaire, Horoscope, Jeux en ligne, Programme TV, Recettes, Restaurant, SMIC, Test débit, Voyage, Signification prénom