VBDico v1.0.0Table des procédures 1 - clsDoc (clsDoc.cls) 2 - clsMot (clsMot.cls) 3 - frmVBDico (frmVBDico.frm) 3.1 - Private Function bEcrireChaine 3.2 - Private Function bLireChaine 3.3 - Private Function bLireGlossaire 3.4 - Private Function bSauverGlossaire 3.5 - Private Function bSignePonctuation 3.6 - Private Function bSignesPonctuation 3.7 - Private Sub AfficherMessage 3.8 - Private Sub CmdChoisirFichierDoc_Click 3.9 - Private Sub CmdCreerGlossaire_Click 3.10 - Private Sub CmdInterrompre_Click 3.11 - Private Sub CmdVoirGlossaire_Click 3.12 - Private Sub CreerDocGlossaire 3.13 - Private Sub CreerDocGlossaire 3.14 - Private Sub Form_Load 3.15 - Private Sub Form_Unload 3.16 - Private Sub LstMode_Click 3.17 - Private Sub LstParcours_Click 3.18 - Private Sub LstTypeIndex_Click 3.19 - Private Sub TxtCheminDocument_Change 3.20 - Private Sub TxtIndexDoc_Change 3.21 - Private Sub VerifierOperationsPossibles 3.22 - Public Function bAjouterMot 3.23 - Public Function bBackupVBDico 3.24 - Public Function bBackupVBDico2 3.25 - Public Function CreerGlossaire 4 - Utilitaires (ModUtil.bas) 4.1 - Public Function bFichierExiste 4.2 - Public Sub AfficherMsgErreur 5 - SelectionFichier (SelectionFichier.bas) 5.1 - Public Function bChoisirUnFichier 5.2 - Public Function bChoisirUnFichierAPI clsDoc (clsDoc.cls) Option Explicit ' ClsDoc : classe pour indexer la liste des documents indexés en mode multi-documents Public sCle$ ' Clé de la collection : code mnémonique du document indexé Public sChemin$ ' Chemin du document indexé Public lNbMotsIndexes& ' Nombre de mots indexés du document indexé clsMot (clsMot.cls) Option Explicit ' ClsMot : classe pour indexer les mots hors dictionnaire Public sMot$ ' Clé de la collection : mot hors dictionnaire Public lNbOccurences& ' Nombre d'occurrences du mot hors dictionnaire ' Sections ou paragraphes selon le type de parcours du document Public sListeSections$, sMemSection$, lNbSectionsDistinctes& frmVBDico (frmVBDico.frm) Option Explicit ' VBDico : faire un glossaire des mots hors dictionnaire ' en parcourant un document Word ou compatible (.doc, .html, ...) ' Par Patrice Dargenton ' patrice.dargenton@free.fr ' http://patrice.dargenton.free.fr/index.html ' www.vbfrance.com/listeauteur2.aspx?ID=1124 ' Documentation : LisezMoi.htm ' Version 1.0 du 15/02/2004 ' Conventions de nommage des variables : ' b pour Boolean (booléen vrai ou faux) ' i pour Integer : % ' l pour Long : & ' r pour nombre Réel : Single! ou Double# ' a pour Array (tableau) : () ' o pour Object (objet ou classe) ' m_ pour variable Membre de la classe ou de la feuille (Form) ' (mais pas pour les constantes) ' Pour pouvoir localiser la ligne ayant provoqué une erreur, mettre bTrapErr = False Private Const bTrapErr As Boolean = True Private m_bInterrompre As Boolean ' Booléen pour pouvoir interrompre l'indexation ' Booléen pour savoir si l'index multidocument doit être sauvé Private m_bIndexMultiDocModifie As Boolean ' Nombre max. d'occurrence du mot affiché dans les listes du glossaire Private Const iNbOccurencesMaxListe% = 14 ' Collection de mots indexés par sMotHorsDico Private m_colMots As New Collection Private m_sTitreDoc$, m_sCheminDoc$, m_sTypeParcours$, m_sTypeIndex$ Private m_bGlossaireInterrompu As Boolean, m_sCheminApp$ ' Collection de mots indexés par sMotHorsDico en multi-documents (MD) Private m_colMotsMD As New Collection ' Collection des documents indexés en mode multi-documents Private m_colDocs As New Collection Private Const rVersionFichierVBDicoDat! = 1! ' Fichiers de sauvegarde de l'index du glossaire multidocument Private Const sFichierVBDicoDat$ = "VBDico.dat" ' Sauvegarde en cours Private Const sFichierVBDicoBak$ = "VBDico.bak" ' Sauvegarde précédente Private Const sFichierVBDicoTmp$ = "VBDico.tmp" ' Sauvegarde de sécurité Private Const sMsgModeMultiDoc$ = "Mode multi-documents" Private Const sTypeParcoursMots$ = "Mots" Private Const sTypeParcoursParagraphes$ = "Paragraphes" Private Const sTypeParcoursSections$ = "Sections" Private Const sTypeParcoursDef$ = sTypeParcoursParagraphes Private Const sTriAlpha$ = "Alphabétique" Private Const sTriFreq$ = "Fréquentiel" Private Const sTriDef$ = sTriAlpha Private Const sModeMonoDoc$ = "Mono-doc" Private Const sModeMultiDoc$ = "Multi-doc" Private Const sModeDef$ = sModeMonoDoc Private Const sIndexMotsHorsDico$ = "Hors-dico" Private Const sIndexMotsTous$ = "Tous" Private Const sIndexDef$ = sIndexMotsHorsDico Private Sub Form_Load() Me.LblAvancement.Caption = "" Me.TxtCheminDocument = "": Me.TxtIndexDoc = "" ' Fichier document traité par défaut m_sCheminApp = App.Path Me.TxtCheminDocument = m_sCheminApp & "\LisezMoi.htm" 'Me.TxtIndexDoc = "LM" ' Clé du document en mode multi-documents ' Remplissage des listes Me.LstParcours.AddItem sTypeParcoursMots Me.LstParcours.AddItem sTypeParcoursParagraphes Me.LstParcours.AddItem sTypeParcoursSections Me.LstParcours = sTypeParcoursDef Me.LstTri.AddItem sTriAlpha Me.LstTri.AddItem sTriFreq Me.LstTri = sTriDef Me.LstMode.AddItem sModeMonoDoc Me.LstMode.AddItem sModeMultiDoc Me.LstMode = sModeDef Me.LstTypeIndex.AddItem sIndexMotsHorsDico Me.LstTypeIndex.AddItem sIndexMotsTous Me.LstTypeIndex = sIndexDef If bLireGlossaire() Then Me.LstMode = sModeMultiDoc VerifierOperationsPossibles End Sub Private Sub Form_Unload(Cancel As Integer) Dim lNbDocs& lNbDocs = m_colDocs.Count If Me.TxtIndexDoc <> "" And lNbDocs > 0 And m_bIndexMultiDocModifie Then Dim iReponse% iReponse = MsgBox("Voulez-vous sauver l'index du glossaire multi-documents (" & _ sFichierVBDicoDat & ") ?" & vbLf & _ "(nombre de documents : " & lNbDocs & ")", _ vbYesNoCancel Or vbQuestion, sMsgModeMultiDoc) If iReponse = vbCancel Then Cancel = True: Exit Sub If iReponse = vbNo Then Exit Sub ' Valider la copie temporaire en copie de sauvegarde pour de bon If Not bBackupVBDico() Then Cancel = True: Exit Sub End If End Sub Private Sub CmdChoisirFichierDoc_Click() ' Gestion de la boîte de dialogue pour choisir un fichier document Word à indexer Dim sFichier$ Const sMsgFiltreDoc$ = _ "Document Word (*.doc)" & vbNullChar & "*.doc" & vbNullChar & _ "Document Html (*.htm ou *.html)" & vbNullChar & "*.htm*" & vbNullChar & _ "Autre document (*.*)" & vbNullChar & "*.*" Const sMsgTitreBoiteDlg$ = _ "Veuillez choisir un fichier de type document Word, Html ou compatible" If bChoisirUnFichierAPI(sFichier, sMsgFiltreDoc, _ sMsgTitreBoiteDlg, m_sCheminApp, Me.hWnd) Then Me.TxtCheminDocument = sFichier VerifierOperationsPossibles End Sub Private Sub CmdCreerGlossaire_Click() Set m_colMots = New Collection ' Recommencer une collection de mots à indexer CreerGlossaire Me.TxtCheminDocument End Sub Private Sub CmdInterrompre_Click() m_bInterrompre = True End Sub Private Sub CmdVoirGlossaire_Click() CreerGlossaire "", bVoirGlossaireCourant:=True End Sub Private Sub VerifierOperationsPossibles() ' Vérifier si le fichier document existe et contrôler les combinaisons possibles ' des options, autoriser l'indexation le cas échéant ' Si une indexation est en cours, ne pas réactiver le bouton CmdCreerGlossaire If Me.CmdInterrompre.Enabled Then Exit Sub Me.CmdVoirGlossaire.Enabled = False If Me.LstMode = sModeMultiDoc Then Me.TxtIndexDoc.Enabled = True If m_colDocs.Count > 0 Then Me.CmdVoirGlossaire.Enabled = True Else Me.TxtIndexDoc.Enabled = False If m_colMots.Count > 0 Then Me.CmdVoirGlossaire.Enabled = True End If Me.CmdCreerGlossaire.Enabled = False If Me.TxtCheminDocument = "" Then Exit Sub If Not bFichierExiste(Me.TxtCheminDocument) Then Exit Sub If Me.LstMode = sModeMultiDoc And Me.TxtIndexDoc = "" Then Exit Sub Me.CmdCreerGlossaire.Enabled = True End Sub Private Sub TxtCheminDocument_Change() VerifierOperationsPossibles End Sub Private Sub LstTypeIndex_Click() ' Type d'indexation : mots hors-dico ou tous les mots ' L'indexation de tous les mots n'est faite qu'en mode parcours des mots If Me.LstTypeIndex = sIndexMotsTous And _ Me.LstParcours <> sTypeParcoursMots Then _ Me.LstParcours = sTypeParcoursMots ' Pas grave : L'indexation de tous les mots est désactivée en mode multi-doc, ' pour éviter d'avoir à vérifier le type d'indexation 'If Me.LstTypeIndex = sIndexMotsTous And _ Me.LstMode <> sModeMonoDoc Then _ Me.LstMode = sModeMonoDoc VerifierOperationsPossibles End Sub Private Sub LstParcours_Click() If Me.LstParcours <> sTypeParcoursMots And _ Me.LstTypeIndex = sIndexMotsTous Then _ Me.LstTypeIndex = sIndexMotsHorsDico VerifierOperationsPossibles End Sub Private Sub LstMode_Click() ' Mode mono-doc ou multi-doc ' Pas grave : L'indexation de tous les mots est désactivée en mode multi-doc, ' pour éviter d'avoir à vérifier le type d'indexation 'If Me.LstMode = sModeMultiDoc And _ Me.LstTypeIndex <> sIndexMotsHorsDico Then _ Me.LstTypeIndex = sIndexMotsHorsDico VerifierOperationsPossibles End Sub Private Sub TxtIndexDoc_Change() ' Code du document = clé d'indexation en mode multi-documents VerifierOperationsPossibles End Sub Public Function CreerGlossaire(ByVal sFichier$, _ Optional bVoirGlossaireCourant As Boolean = False) m_bInterrompre = False ' Autoriser l'interruption de l'indexation Me.CmdInterrompre.Enabled = True ' Interdire la réentrance dans cette fonction Me.CmdCreerGlossaire.Enabled = False Me.CmdVoirGlossaire.Enabled = False ' Déclaration d'un objet Word ' Pour utiliser la liaison précoce, on déclare bLiaisonPrecoce = -1 ' dans les arguments de compilation conditionnelle : ' cf. VBDico_LiaisonPrecoce.vbp #If bLiaisonPrecoce Then ' Liaison précoce : déclaration avant la compilation ' C'est plus pratique lorsqu'il y a plusieurs variables liées à Word ' (Range, Paragraph, Section...) ' - avantage : intellisense pour déboguer la programmation Word ' (obtenir la liste des méthodes et constantes possibles sur un objet) ' - inconvénient : le programme requiert une référence à ' "Microsoft Word 10 Object Library" : Word XP (2002) doit donc être installé, ' sinon, le logiciel plante si vous ne changez pas la référence ' pour mettre votre version de Word, ou bien si Word n'est pas installé Dim oWrd As Word.Application Dim oColMotsHorsDico As ProofreadingErrors ' Collection des mots hors dico Dim oMotHorsDico As Range ' Chaque mot de la collection des mots hors dico Dim oParagraphe As Paragraph Dim oSection As Section #Else ' Liaison tardive : déclaration au moment de l'exécution ' - avantage : le programme ne plante pas si Word n'est pas installé, ' et un message approprié peut donc être affiché ; marche avec toutes les versions ' de Word qui gèrent le code VBA utilisé ici (je n'ai pas testé avec Word 97) ' - inconvénient : pas d'intellisense pour déboguer, et le code est moins clair Const wdDoNotSaveChanges& = 0 Dim oWrd As Object Dim oColMotsHorsDico As Object ' Collection des mots hors dico Dim oMotHorsDico As Object ' Chaque mot de la collection des mots hors dico Dim oParagraphe As Object Dim oSection As Object #End If ' En mode multi-doc, vérification de l'unicité de la clé d'indexation On Error Resume Next Dim bMultiDocs As Boolean If Me.TxtIndexDoc <> "" And Me.LstMode = sModeMultiDoc And _ Not bVoirGlossaireCourant Then bMultiDocs = True Dim oDoc As New clsDoc oDoc.sChemin = sFichier oDoc.sCle = Me.TxtIndexDoc m_colDocs.Add oDoc, oDoc.sCle If Err = 457 Then MsgBox "La clé '" & Me.TxtIndexDoc & _ "' a déjà été utilisée dans le glossaire multi-documents", _ vbCritical, sMsgModeMultiDoc: GoTo Fin ElseIf Err <> 0 Then AfficherMsgErreur Err, "CreerGlossaire", vbCritical, _ sMsgModeMultiDoc: GoTo Fin End If m_bIndexMultiDocModifie = True End If AfficherMessage "Ouverture de Microsoft Word..." ' Instanciation de l'objet Word : vérifier si Word est déjà ouvert ' (note : si VB6 dit que oWrd n'est pas défini, quitter et relancer VB6) Set oWrd = GetObject(, "Word.Application") If Err <> 0 Then Err.Clear Set oWrd = CreateObject("Word.Application") 'Set oWrd = New Word.Application ' Code équivalent End If If Err <> 0 Then AfficherMsgErreur Err, "CreerGlossaire", _ "Impossible de lancer Microsoft Word !", vbCritical: GoTo Fin ' Rattraper les erreurs (sauf en mode déboguage) If bTrapErr Then On Error GoTo Erreur Else On Error GoTo 0 Dim bTriFreq As Boolean bTriFreq = False If Me.LstTri = sTriFreq Then bTriFreq = True If Me.LstMode = sModeMultiDoc Then bMultiDocs = True ' Optimisation : désactiver la correction grammatical ' avant d'ouvrir de gros documents ' Comment faire pour trouver les bonnes options de Word ? Réponse : ' utiliser l'enregistreur de macro de Word et examiner le code produit ! Dim bMemCheckSpellingAsYouType As Boolean Dim bMemCheckGrammarAsYouType As Boolean Dim bMemCheckGrammarWithSpelling As Boolean With oWrd.Options ' Mémoriser les options pour pouvoir les rétablir une fois terminé bMemCheckSpellingAsYouType = .CheckSpellingAsYouType bMemCheckGrammarAsYouType = .CheckGrammarAsYouType bMemCheckGrammarWithSpelling = .CheckGrammarWithSpelling .CheckSpellingAsYouType = False .CheckGrammarAsYouType = False .CheckGrammarWithSpelling = False End With ' Voir le glossaire courant If bVoirGlossaireCourant Then GoTo CreationGlossaire ' Recréer le glossaire m_bGlossaireInterrompu = False ' Supprimer les mots ignorés par le correcteur orthog. dans le dictionnaire actif oWrd.ResetIgnoreAll AfficherMessage "Ouverture du document : " & sFichier & "..." oWrd.Documents.Open sFichier Dim lNbMotsHorsDico&, lNumMotHorsDico& Dim lNbMotsHorsDicoIndexes&, sMotHorsDico$ With oWrd.ActiveDocument ' Recommencer la vérification de l'orthographe après la réinitialisation du dico .SpellingChecked = False ' Type de parcours d'un document : ' Mots : Méthode la plus lente ' Paragraphes : Méthode la plus rapide ' Sections : Méthode la plus sûr pour les gros documents Select Case Me.LstParcours Case sTypeParcoursSections: Dim lNbSections&, lNumSection& AfficherMessage "Comptage du nombre de sections..." lNbSections = .Sections.Count ' Parcourir les sections du document For Each oSection In .Sections lNumSection = lNumSection + 1 AfficherMessage "Détection des mots hors dico dans la section n°" & _ lNumSection & " / " & lNbSections & "..." If m_bInterrompre Then Exit For ' Test d'optimisation en faisant la vérification section par section ' dans un nouveau document Word : cela ne change rien '.Documents.Add 'oSection.Range.Copy '.Range.Paste 'Set oColMotsHorsDico = .SpellingErrors Set oColMotsHorsDico = oSection.Range.SpellingErrors lNbMotsHorsDico = oColMotsHorsDico.Count If lNbMotsHorsDico = 0 Then GoTo SectionSuivante AfficherMessage "Parcours des mots hors dico dans la section n°" & _ lNumSection & " / " & lNbSections & "..." If m_bInterrompre Then Exit For lNumMotHorsDico = 0 For Each oMotHorsDico In oColMotsHorsDico lNumMotHorsDico = lNumMotHorsDico + 1 AfficherMessage "Indexation des mots hors dico dans la section n°" & _ lNumSection & " / " & lNbSections & _ ", mot n°" & lNumMotHorsDico & " / " & lNbMotsHorsDico & _ ", mots indexés : " & lNbMotsHorsDicoIndexes If m_bInterrompre Then Exit For sMotHorsDico = oMotHorsDico.Text If Not bAjouterMot(m_colMots, sMotHorsDico, CStr(lNumSection)) Then _ GoTo Fin If bMultiDocs Then If Not bAjouterMot(m_colMotsMD, sMotHorsDico, Me.TxtIndexDoc) Then _ GoTo Fin m_bIndexMultiDocModifie = True End If lNbMotsHorsDicoIndexes = m_colMots.Count Next oMotHorsDico ' Test d'optimisation : suite et fin ' Enlever le message presse-papier rempli en copiant juste 1 caractère '.Characters(1).Copy '.Close wdDoNotSaveChanges SectionSuivante: Next oSection If lNbMotsHorsDicoIndexes = 0 Then GoTo AucunMotHorsDico Case sTypeParcoursParagraphes: Dim lNbParag&, lNumParag& AfficherMessage "Comptage du nombre de paragraphes..." lNbParag = .Paragraphs.Count For Each oParagraphe In .Paragraphs lNumParag = lNumParag + 1 AfficherMessage "Indexation des mots hors dico : paragraphe n°" & _ lNumParag & " / " & lNbParag & _ ", mots indexés : " & lNbMotsHorsDicoIndexes If m_bInterrompre Then Exit For Set oColMotsHorsDico = oParagraphe.Range.SpellingErrors lNbMotsHorsDico = oColMotsHorsDico.Count If lNbMotsHorsDico = 0 Then GoTo ParagrapheSuivant lNumMotHorsDico = 0 For Each oMotHorsDico In oColMotsHorsDico lNumMotHorsDico = lNumMotHorsDico + 1 sMotHorsDico = oMotHorsDico.Text If Not bAjouterMot(m_colMots, sMotHorsDico, CStr(lNumParag)) Then _ GoTo Fin If bMultiDocs Then If Not bAjouterMot(m_colMotsMD, sMotHorsDico, Me.TxtIndexDoc) Then _ GoTo Fin m_bIndexMultiDocModifie = True End If Next oMotHorsDico lNbMotsHorsDicoIndexes = m_colMots.Count ParagrapheSuivant: Next oParagraphe If lNbMotsHorsDicoIndexes = 0 Then GoTo AucunMotHorsDico Case sTypeParcoursMots: AfficherMessage "Comptage du nombre de mots hors dico en tout..." If Me.LstTypeIndex = sIndexMotsHorsDico Then ' Indexer les mots hors dictionnaire lNbMotsHorsDico = .SpellingErrors.Count If lNbMotsHorsDico = 0 Then GoTo AucunMotHorsDico For lNumMotHorsDico = 1 To lNbMotsHorsDico If lNumMotHorsDico Mod 10 = 0 Or lNumMotHorsDico = lNbMotsHorsDico Or _ lNumMotHorsDico = 1 Then lNbMotsHorsDicoIndexes = m_colMots.Count AfficherMessage "Indexation des mots hors dico : " & _ lNumMotHorsDico & " / " & lNbMotsHorsDico & _ ", mots indexés : " & lNbMotsHorsDicoIndexes If m_bInterrompre Then Exit For End If sMotHorsDico = .SpellingErrors(lNumMotHorsDico) If Not bAjouterMot(m_colMots, sMotHorsDico) Then GoTo Fin If bMultiDocs Then If Not bAjouterMot(m_colMotsMD, sMotHorsDico, Me.TxtIndexDoc) Then _ GoTo Fin m_bIndexMultiDocModifie = True End If Next lNumMotHorsDico Else ' Indexer tous les mots Dim lNbMots&, lNumMot&, lNbMotsIndexes&, sMot$ lNbMots = .Words.Count If lNbMots = 0 Then GoTo AucunMotHorsDico For lNumMot = 1 To lNbMots If lNumMot Mod 10 = 0 Or lNumMot = lNbMots Or _ lNumMot = 1 Then lNbMotsIndexes = m_colMots.Count AfficherMessage "Indexation des mots : " & _ lNumMot & " / " & lNbMots & _ ", mots indexés : " & lNbMotsIndexes If m_bInterrompre Then Exit For End If sMot = Trim$(.Words(lNumMot)) If bSignesPonctuation(sMot) Then GoTo MotSuivant If Not bAjouterMot(m_colMots, sMot) Then GoTo Fin If bMultiDocs Then If Not bAjouterMot(m_colMotsMD, sMot, Me.TxtIndexDoc) Then _ GoTo Fin m_bIndexMultiDocModifie = True End If MotSuivant: Next lNumMot End If lNbMotsHorsDicoIndexes = m_colMots.Count End Select ' Conserver le nombre de mots indexés de chaque document analysé oDoc.lNbMotsIndexes = m_colMots.Count ' Conserver le nom du document m_sTitreDoc = .Name m_sCheminDoc = .FullName m_sTypeParcours = Me.LstParcours m_sTypeIndex = Me.LstTypeIndex ' Fermer le document d'origine, on en a plus besoin .Close End With ' Faire une sauvegarde des données du glossaire dans le fichier VBDico.tmp If bMultiDocs And Not m_bInterrompre Then _ bSauverGlossaire sFichierVBDicoTmp m_bGlossaireInterrompu = m_bInterrompre ' Possibilité d'interrompre le parcours du document mais pas ' l'affichage du glossaire tel quel m_bInterrompre = False ' 1 = Checked, 0 = Unchecked (ne pas faire Not Me.Chk directement !) If Not (Me.ChkAfficherGlossaire = 1) And Not bVoirGlossaireCourant Then ' Ne pas afficher le glossaire (utile en mode multi-doc) ' Quitter Word invisible If bTrapErr Then On Error Resume Next GoSub RetablirOptionsWord oWrd.Quit wdDoNotSaveChanges ' Fermer Word Set oWrd = Nothing GoTo Fin End If CreationGlossaire: Dim sMethode$, sExplication$, sTitre$, sTxtMotHorsDico$ Dim sListeMax$, sDetailExplic$, sTitreComptage$, sChemin$ If m_sCheminDoc = "" Then GoTo CreationGlossaireMultiDoc sTitreComptage = "Nombre de mots distincts hors dictionnaire : " sListeMax = " <= " & iNbOccurencesMaxListe & ")" & vbLf sTxtMotHorsDico = " hors dico" If m_sTypeIndex = sIndexMotsTous Then sTxtMotHorsDico = "" sTitreComptage = "Nombre de mots distincts : " End If sChemin = "Chemin : " & m_sCheminDoc Select Case m_sTypeParcours Case sTypeParcoursSections: sMethode = "sections distinctes" Case sTypeParcoursParagraphes: sMethode = "paragraphes distincts" Case sTypeParcoursMots: sExplication = "Explication : Mot" & sTxtMotHorsDico & _ " (nombre d'occurrences)" & vbLf sTitre = "Glossaire de " & m_sTitreDoc If bTriFreq Then sTitre = sTitre & " en fréquence" sExplication = "Explication : Nombre d'occurrences : Mot" & _ sTxtMotHorsDico & vbLf End If End Select If m_sTypeParcours <> sTypeParcoursMots Then sDetailExplic = " (nombre d'occurrences : liste des numéros de " & _ sMethode & sListeMax sExplication = "Explication : Mot" & sTxtMotHorsDico & sDetailExplic sTitre = "Glossaire de " & m_sTitreDoc If bTriFreq Then sTitre = sTitre & " en fréquence" sDetailExplic = " (liste des numéros de " & sMethode & sListeMax sExplication = "Explication : Nombre d'occurrences : Mot" & _ sTxtMotHorsDico & sDetailExplic End If End If CreerDocGlossaire oWrd, m_colMots, sTitre, sChemin, sTitreComptage, _ sExplication, bTriFreq, m_bGlossaireInterrompu, bMultiDocs:=False CreationGlossaireMultiDoc: sTitreComptage = "Nombre de mots distincts hors dictionnaire : " sListeMax = " <= " & iNbOccurencesMaxListe & ")" & vbLf sTxtMotHorsDico = " hors dico" If m_sTypeIndex = sIndexMotsTous Then sTxtMotHorsDico = "" sTitreComptage = "Nombre de mots distincts : " End If If bMultiDocs Then sTitre = "Glossaire multi-documents" sChemin = "" If m_sTitreDoc <> "" Then _ sChemin = "Dernier document : " & m_sTitreDoc & " : " & m_sCheminDoc sExplication = "Explication : Mot" & sTxtMotHorsDico & _ " (nombre d'occurrences : liste des codes des documents" & sListeMax If bTriFreq Then sTitre = sTitre & " en fréquence" sExplication = "Explication : Nombre d'occurrences : Mot" & _ sTxtMotHorsDico & " (liste des codes des documents" & sListeMax End If CreerDocGlossaire oWrd, m_colMotsMD, sTitre, sChemin, sTitreComptage, _ sExplication, bTriFreq, m_bGlossaireInterrompu, bMultiDocs:=True End If AfficherMessage "Création du glossaire terminée." oWrd.Visible = True 'AppActivate "Word" ' Insuffisant pour corriger le petit bug d'activation Fin: Me.CmdCreerGlossaire.Enabled = True Me.CmdVoirGlossaire.Enabled = True Me.CmdInterrompre.Enabled = False If bTrapErr Then On Error Resume Next GoSub RetablirOptionsWord Set oColMotsHorsDico = Nothing Set oMotHorsDico = Nothing Set oSection = Nothing Set oParagraphe = Nothing AfficherMessage "Opération terminée." VerifierOperationsPossibles Exit Function AucunMotHorsDico: If bTrapErr Then On Error Resume Next GoSub RetablirOptionsWord ' Fermer Word oWrd.Quit wdDoNotSaveChanges Set oWrd = Nothing MsgBox "Aucun mot n'est absent du dictionnaire !", vbExclamation GoTo Fin Erreur: AfficherMsgErreur Err, "CreerGlossaire" GoSub RetablirOptionsWord On Error Resume Next If Not (oWrd Is Nothing) Then oWrd.Quit wdDoNotSaveChanges Set oWrd = Nothing End If On Error GoTo 0 GoTo Fin RetablirOptionsWord: If Not (oWrd Is Nothing) Then ' Rétablir les options de Word ' Il y a déjà eu une erreur : impossible de ratrapper l'erreur à nouveau ! 'If bTrapErr Then Err.Clear: On Error Resume Next oWrd.Options.CheckSpellingAsYouType = bMemCheckSpellingAsYouType oWrd.Options.CheckGrammarAsYouType = bMemCheckGrammarAsYouType oWrd.Options.CheckGrammarWithSpelling = bMemCheckGrammarWithSpelling End If Return End Function Private Function bSignesPonctuation(sMot$) As Boolean ' Indiquer si le mot ne contient que des signes de ponctuation Dim i%, iLen% iLen = Len(sMot) For i = 1 To iLen If Not bSignePonctuation(Mid$(sMot, i, 1)) Then Exit Function Next i bSignesPonctuation = True ' Ce mot ne contient que des signes de ponctuation End Function Private Function bSignePonctuation(sCar$) As Boolean ' Indiquer si le caractère est un signe de ponctuation Dim iCode% iCode = Asc(sCar) Select Case iCode Case Asc("A") To Asc("Z") ' Majuscule Case Asc("a") To Asc("z") ' Minuscule Case Else ' Ponctuation et chiffre bSignePonctuation = True End Select End Function ' Tout ça pour conserver l'intellisense en mode débug... #If bLiaisonPrecoce Then Private Sub CreerDocGlossaire(oWrd As Word.Application, m_colMots As Collection, _ sTitre$, sChemin$, sTitreComptage$, sExplication$, _ bTriFreq As Boolean, bGlossaireInterrompu As Boolean, bMultiDocs As Boolean) #Else Private Sub CreerDocGlossaire(oWrd As Object, m_colMots As Collection, _ sTitre$, sChemin$, sTitreComptage$, sExplication$, _ bTriFreq As Boolean, bGlossaireInterrompu As Boolean, bMultiDocs As Boolean) Const wdDoNotSaveChanges& = 0 Const wdSortFieldAlphanumeric& = 0 Const wdSortOrderAscending& = 0 Const wdFrench& = 1036 Const wdSortFieldNumeric& = 1 Const wdSortOrderDescending& = 1 Const wdPageFitBestFit& = 2 #End If 'Debug.Print wdSortSeparateByDefaultTableSeparator ' 2 ' Fabrication du glossaire à partir de la collection de mots indexés With oWrd ' Ajouter la collection de mots dans un nouveau document Word .Documents.Add Dim oMot As clsMot, sMotGlossaire$, lNumMotHorsDicoIndexe& Dim lNbMotsHorsDicoIndexes& lNbMotsHorsDicoIndexes = m_colMots.Count lNumMotHorsDicoIndexe = 0 For Each oMot In m_colMots lNumMotHorsDicoIndexe = lNumMotHorsDicoIndexe + 1 If lNumMotHorsDicoIndexe Mod 100 = 0 Or _ lNumMotHorsDicoIndexe = lNbMotsHorsDicoIndexes Or _ lNumMotHorsDicoIndexe = 1 Then AfficherMessage "Création du " & sTitre & " : " & _ lNumMotHorsDicoIndexe & " / " & lNbMotsHorsDicoIndexes DoEvents If m_bInterrompre Then Exit For End If If bTriFreq Then ' Tri fréquentiel : on met le nombre d'occurence du mot en premier If oMot.sListeSections <> "" Then sMotGlossaire = oMot.lNbOccurences & " : " & oMot.sMot & " (" & _ oMot.sListeSections & ")" & vbLf Else ' Cas indexation avec la boucle sur les mots ' ' (pas de pointeur dans ce cas) sMotGlossaire = oMot.lNbOccurences & " : " & oMot.sMot & vbLf ' Plus besoin de _ avec Sort FieldNumber:="Mot 1" au lieu de § ' On met _ pour forcer le tri numérique sur la seule fréquence ' et non sur le contenu du mot qui peut être numérique parfois 'sMotGlossaire = oMot.lNbOccurences & " _" & oMot.sMot & vbLf End If Else ' Tri alphabétique : on met le mot en premier If oMot.sListeSections <> "" Then sMotGlossaire = oMot.sMot & " (" & oMot.lNbOccurences & " : " & _ oMot.sListeSections & ")" & vbLf Else ' Cas indexation avec la boucle sur les mots sMotGlossaire = oMot.sMot & " (" & oMot.lNbOccurences & ")" & vbLf End If End If .ActiveDocument.Content.InsertAfter sMotGlossaire Next oMot ' Trier le nouveau document Word par ordre alphabétique ou bien numérique AfficherMessage "Tri du glossaire..." .ActiveDocument.Content.WholeStory ' Sélection de tout le document Dim lMethodeTri&, lOrdreTri& lMethodeTri = wdSortFieldAlphanumeric: lOrdreTri = wdSortOrderAscending If bTriFreq Then _ lMethodeTri = wdSortFieldNumeric: lOrdreTri = wdSortOrderDescending If lNbMotsHorsDicoIndexes > 0 Then _ .ActiveDocument.Content.Sort FieldNumber:="Mot 1", _ SortFieldType:=lMethodeTri, SortOrder:=lOrdreTri, _ LanguageID:=wdFrench ' Présentation du glossaire If bTriFreq Then .ActiveDocument.Content.InsertBefore vbLf .ActiveDocument.Content.InsertBefore sExplication .ActiveDocument.Content.InsertBefore _ sTitreComptage & lNbMotsHorsDicoIndexes & vbLf If bMultiDocs Then ' Afficher la liste des documents indexés en mode multi-documents Dim oDoc As clsDoc For Each oDoc In m_colDocs .ActiveDocument.Content.InsertBefore oDoc.sChemin & _ " (" & oDoc.sCle & ", " & oDoc.lNbMotsIndexes & " mots)" & vbLf Next oDoc Else ' Sinon afficher le chemin du document analysé If sChemin <> "" Then _ .ActiveDocument.Content.InsertBefore sChemin & vbLf End If If bGlossaireInterrompu Then _ .ActiveDocument.Content.InsertBefore "(Glossaire interrompu)" & vbLf .ActiveDocument.Content.InsertBefore sTitre & vbLf ' Mettre en largeur de page maximale pour améliorer la lisibilité du document .ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit End With End Sub Public Function bAjouterMot(ByRef m_colMots As Collection, sMot$, _ Optional sSection$ = "") As Boolean ' Indexation des mots hors dico (ou bien tous les mots) ' pour ne conserver que les mots distincts ' sSection : En mode simple document, numéro de la section ou du paragraphe ' selon le type de parcours du document ' sSection : En mode multidocument, code mnémonique du document ' (par exemple LM pour LisezMoi) Dim sCle$, iErr%, mot As clsMot sCle = sMot On Error Resume Next Set mot = m_colMots.Item(sCle) ' Collection de mots indexés par sMot iErr = Err If bTrapErr Then On Error GoTo Erreur Else On Error GoTo 0 If iErr And iErr <> 5 Then GoTo Erreur If iErr = 5 Then ' Référence inexistante dans la collection, on l'ajoute Err.Clear Set mot = New clsMot With mot .sMot = sMot .lNbOccurences = 1 If sSection <> "" Then .sListeSections = sSection .sMemSection = sSection End If End With m_colMots.Add mot, sCle ' Ajout dans la collection Else ' Mot déjà existant : incrémenter le nombre d'occurrences With mot .lNbOccurences = .lNbOccurences + 1 If sSection <> "" And sSection <> .sMemSection Then .lNbSectionsDistinctes = .lNbSectionsDistinctes + 1 .sMemSection = sSection If .lNbSectionsDistinctes < iNbOccurencesMaxListe - 1 Then .sListeSections = .sListeSections & ", " & sSection ElseIf .lNbSectionsDistinctes = iNbOccurencesMaxListe - 1 Then .sListeSections = .sListeSections & ", " & sSection & "..." End If End If End With End If bAjouterMot = True Fin: Exit Function Erreur: ' Exemple d'erreur possible : mémoire insuffisante ! AfficherMsgErreur Err, "bAjouterMot" Resume Fin End Function Private Sub AfficherMessage(sMsg$) Me.LblAvancement.Caption = sMsg ' Laisser du temps pour le traitement des messages : affichage du message et ' traitement du clic éventuel sur le bouton Interrompre DoEvents End Sub Public Function bBackupVBDico() As Boolean ' Conserver la sauvegarde précédente (si elle existe) : ' renommer le fichier VBDico.dat en VBDico.bak ' Conserver la dernière sauvergarde (elle doit exister) : ' renommer le fichier VBDico.tmp en VBDico.dat Dim sCheminVBDicoTmp$, sCheminVBDicoBak$, sCheminVBDicoDat$ sCheminVBDicoTmp = m_sCheminApp & "\" & sFichierVBDicoTmp sCheminVBDicoBak = m_sCheminApp & "\" & sFichierVBDicoBak sCheminVBDicoDat = m_sCheminApp & "\" & sFichierVBDicoDat ' Si le fichier .tmp n'existe plus, ce n'est pas normale ! ' on resauve quand même le fichier If Not bFichierExiste(sCheminVBDicoTmp) Then _ If Not bSauverGlossaire(sCheminVBDicoTmp) Then GoTo Fin If bTrapErr Then On Error GoTo Erreur Else On Error GoTo 0 ' Renommer le fichier VBDico.dat en VBDico.bak If bFichierExiste(sCheminVBDicoDat) Then ' Si le fichier .bak existe, le supprimer avant If bFichierExiste(sCheminVBDicoBak) Then Kill sCheminVBDicoBak Name sCheminVBDicoDat As sCheminVBDicoBak End If ' Renommer le fichier VBDico.tmp en VBDico.dat Name sCheminVBDicoTmp As sCheminVBDicoDat bBackupVBDico = True Fin: Exit Function Erreur: AfficherMsgErreur Err, "bBackupVBDico" Resume Fin End Function Public Function bBackupVBDico2() As Boolean ' Autre façon de faire un backup Dim oFSO As Object On Error Resume Next Set oFSO = CreateObject("Scripting.FileSystemObject") If Err <> 0 Then AfficherMsgErreur Err, "bBackupVBDico2", _ "Scripting.FileSystemObject n'est pas disponible": Exit Function Dim sCheminVBDicoDat$, sCheminVBDicoBak$ sCheminVBDicoDat = m_sCheminApp & "\" & sFichierVBDicoDat sCheminVBDicoBak = m_sCheminApp & "\" & sFichierVBDicoBak If bTrapErr Then On Error GoTo Erreur Else On Error GoTo 0 oFSO.CopyFile sCheminVBDicoDat, sCheminVBDicoBak bBackupVBDico2 = True Fin: Set oFSO = Nothing Exit Function Erreur: AfficherMsgErreur Err, "bBackupVBDico2" Resume Fin End Function Private Function bSauverGlossaire(sFichierVBDico$) As Boolean ' Ecrire l'index du glossaire multi-documents dans VBDico.dat Me.MousePointer = vbHourglass If bTrapErr Then On Error GoTo Erreur Else On Error GoTo 0 Dim iNumFichier% iNumFichier = FreeFile Open m_sCheminApp & "\" & sFichierVBDico For Binary Access Write As #iNumFichier Put #iNumFichier, , rVersionFichierVBDicoDat ' On ne vérifie pas si le mode d'indexation à changé entre les ' différents documents analysés (risque d'incohérence) Dim iTypeIndex% ', bIndexMotsTous As Boolean iTypeIndex = 0 ': bIndexMotsTous = False If m_sTypeIndex = sIndexMotsTous Then iTypeIndex = 1 ': bIndexMotsTous = True Put #iNumFichier, , iTypeIndex ' Sauvegarde du nombre de documents indexés Dim lNbDocs& lNbDocs = m_colDocs.Count Put #iNumFichier, , lNbDocs ' Sauvegarde de la liste des documents indexés Dim oDoc As clsDoc For Each oDoc In m_colDocs bEcrireChaine iNumFichier, oDoc.sCle bEcrireChaine iNumFichier, oDoc.sChemin Put #iNumFichier, , oDoc.lNbMotsIndexes Next oDoc ' Sauvegarde des données du glossaire Dim lNbMots& lNbMots = m_colMotsMD.Count Put #iNumFichier, , lNbMots Dim oMot As clsMot For Each oMot In m_colMotsMD bEcrireChaine iNumFichier, oMot.sMot Put #iNumFichier, , oMot.lNbOccurences Put #iNumFichier, , oMot.lNbSectionsDistinctes bEcrireChaine iNumFichier, oMot.sListeSections bEcrireChaine iNumFichier, oMot.sMemSection Next oMot Close #iNumFichier bSauverGlossaire = True Fin: Me.MousePointer = vbDefault Exit Function Erreur: Close ' Fermer tous les fichiers ouverts Me.MousePointer = vbDefault AfficherMsgErreur Err, "bSauverGlossaire" Resume Fin End Function Private Function bEcrireChaine(iNumFichier%, ByRef sChaine$) As Boolean ' Ecrire une chaîne de longueur variable dans un fichier binaire ' on utilise ByRef pour éviter de réallouer la chaîne en RAM Dim iLongChaine% iLongChaine = Len(sChaine) Put #iNumFichier, , iLongChaine Put #iNumFichier, , sChaine bEcrireChaine = True End Function Private Function bLireChaine(iNumFichier%, ByRef sChaine$) As Boolean ' Lire une chaîne de longueur variable dans un fichier binaire ' pour cela, il faut d'abord sauver la longueur de la chaîne Dim iLongChaine% ' Lire d'abord la longueur de la chaîne Get #iNumFichier, , iLongChaine If iLongChaine <= 0 Then Exit Function ' C'est surement une erreur si la chaîne est trop longue If iLongChaine > 255 Then Exit Function sChaine = Space(iLongChaine) ' = String(iLongChaine, " ") Get #iNumFichier, , sChaine bLireChaine = True End Function Private Function bLireGlossaire() As Boolean ' Lire l'index du glossaire multidocument dans VBDico.dat If bTrapErr Then On Error GoTo Erreur Else On Error GoTo 0 Dim sCheminFichier$, rVersionFichier!, lNbMots& sCheminFichier = m_sCheminApp & "\" & sFichierVBDicoDat If Not bFichierExiste(sCheminFichier) Then GoTo Fin If vbNo = MsgBox("Voulez-vous recharger l'index du glossaire (" & _ sFichierVBDicoDat & ") ?", vbYesNo Or vbQuestion, _ sMsgModeMultiDoc) Then GoTo Fin Me.MousePointer = vbHourglass Dim iNumFichier% iNumFichier = FreeFile Open sCheminFichier For Binary Access Read As #iNumFichier Dim sMsgErr$, sMsgErrLecture$ sMsgErrLecture$ = "Version de fichier incorrecte : " & sCheminFichier Get #iNumFichier, , rVersionFichier If rVersionFichier <> rVersionFichierVBDicoDat Then _ sMsgErr = sMsgErrLecture: GoTo Fermeture Dim iTypeIndex% ', bIndexMotsTous As Boolean Get #iNumFichier, , iTypeIndex m_sTypeIndex = sIndexMotsHorsDico If iTypeIndex = 1 Then m_sTypeIndex = sIndexMotsTous ': bIndexMotsTous = True Dim lNbDocs& Get #iNumFichier, , lNbDocs sMsgErrLecture$ = "Fichier vide : " & sCheminFichier If lNbDocs = 0 Then GoTo Fermeture Dim i&, sCheminDoc$, sCleDoc$, oDoc As clsDoc, lNb& sMsgErrLecture$ = "Impossible de lire le fichier : " & sCheminFichier For i = 0 To lNbDocs - 1 Set oDoc = New clsDoc If Not bLireChaine(iNumFichier, sCleDoc) Then _ sMsgErr = sMsgErrLecture: GoTo Fermeture oDoc.sCle = sCleDoc If Not bLireChaine(iNumFichier, sCheminDoc) Then _ sMsgErr = sMsgErrLecture: GoTo Fermeture oDoc.sChemin = sCheminDoc Get #iNumFichier, , lNb oDoc.lNbMotsIndexes = lNb m_colDocs.Add oDoc, sCleDoc Next i Get #iNumFichier, , lNbMots sMsgErrLecture$ = "Fichier vide : " & sCheminFichier If lNbMots = 0 Then GoTo Fermeture Dim oMot As clsMot, sChaine$ sMsgErrLecture$ = "Impossible de lire le fichier : " & sCheminFichier For i = 0 To lNbMots - 1 Set oMot = New clsMot If Not bLireChaine(iNumFichier, sChaine) Then _ sMsgErr = sMsgErrLecture: GoTo Fermeture oMot.sMot = sChaine Get #iNumFichier, , lNb oMot.lNbOccurences = lNb Get #iNumFichier, , lNb oMot.lNbSectionsDistinctes = lNb If Not bLireChaine(iNumFichier, sChaine) Then _ sMsgErr = sMsgErrLecture: GoTo Fermeture oMot.sListeSections = sChaine If Not bLireChaine(iNumFichier, sChaine) Then _ sMsgErr = sMsgErrLecture: GoTo Fermeture oMot.sMemSection = sChaine m_colMotsMD.Add oMot, oMot.sMot ' Ajouter le mot dans la collection Next i bLireGlossaire = True Fermeture: Close #iNumFichier Fin: Me.MousePointer = vbDefault m_bIndexMultiDocModifie = False Exit Function Erreur: Close ' Fermer tous les fichiers ouverts Me.MousePointer = vbDefault AfficherMsgErreur Err, "bLireGlossaire", sMsgErr Resume Fin End Function Utilitaires (ModUtil.bas) Option Explicit ' Module de fonctions utilitaires Public Const sTitreMsg$ = "VBDico" Public Function bFichierExiste(sCheminFichier$) As Boolean ' Retourner l'existence ou non d'un fichier avec un chemin complet On Error Resume Next bFichierExiste = (Len(Dir$(sCheminFichier)) > 0) If Err <> 0 Then bFichierExiste = False End Function Public Sub AfficherMsgErreur(Erreur As Object, Optional sTitreFct$ = "", _ Optional sInfo$ = "", Optional sDetailMsgErr$ = "") Const vbDefault% = 0 If Screen.MousePointer <> vbDefault Then Screen.MousePointer = vbDefault Dim sMsg$ If sTitreFct <> "" Then sMsg = "Fonction : " & sTitreFct If sInfo <> "" Then sMsg = sMsg & vbCrLf & sInfo If Erreur.Number Then sMsg = sMsg & vbCrLf & "Err n°" & Str$(Erreur.Number) & " :" sMsg = sMsg & vbCrLf & Erreur.Description End If If sDetailMsgErr <> "" Then sMsg = sMsg & vbCrLf & sDetailMsgErr MsgBox sMsg, vbCritical, sTitreMsg End Sub SelectionFichier (SelectionFichier.bas) Option Explicit ' Sélection d'un fichier (à cause de la limite du MSComDlg.CommonDialog) Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Public Function bChoisirUnFichierAPI(ByRef sFichier$, sFiltre$, sTitre$, _ sInitDir$, lHandelWnd&) As Boolean Dim OpenFile As OPENFILENAME Dim lRet& OpenFile.lStructSize = Len(OpenFile) OpenFile.hwndOwner = lHandelWnd OpenFile.lpstrFilter = sFiltre OpenFile.nFilterIndex = 1 OpenFile.lpstrFile = String(257, 0) OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1 OpenFile.lpstrFileTitle = OpenFile.lpstrFile OpenFile.nMaxFileTitle = OpenFile.nMaxFile OpenFile.lpstrInitialDir = sInitDir OpenFile.lpstrTitle = sTitre OpenFile.flags = &H1000 ' FileMustExist (OFN_FILEMUSTEXIST) lRet = GetOpenFileName(OpenFile) If lRet = 0 Then sFichier = "" Else sFichier = Trim$(OpenFile.lpstrFile) ' Enlever les caractères null à la fin Dim iPos% iPos = InStr(sFichier, vbNullChar) If iPos Then sFichier = Left$(sFichier, iPos - 1) bChoisirUnFichierAPI = True End If End Function Public Function bChoisirUnFichier(ByRef sFichier$) As Boolean Dim oDLG As Object ' Ce contrôle ne marche que si VB6 est installé sur le poste client ' c'est une (idiote) restriction de licence On Error GoTo Erreur 'Err.Raise 429 ' Test traitement d'err si VB6 n'est pas installé Set oDLG = CreateObject("MSComDlg.CommonDialog") With oDLG .InitDir = App.Path .DialogTitle = "Choisir une base de données Access" .Filter = "Base de données MS-Access (*.mdb)|*.mdb" .MaxFileSize = 255 .flags = .flags Or &H1000 ' FileMustExist (OFN_FILEMUSTEXIST) .ShowOpen If .FileName <> "" Then sFichier = .FileName: bChoisirUnFichier = True End With Set oDLG = Nothing Exit Function Erreur: If Err = 429 Then AfficherMsgErreur Err, "bChoisirUnFichier", _ "L'environnement Visual Basic 6 ou Visual Studio 6 est requis", _ "Il n'y a pas de licence valide pour ce contrôle" Else AfficherMsgErreur Err, "bChoisirUnFichier" End If Err.Clear End Function