IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Rechercher mot dans entête et pied de page Word depuis Excel VBA


Sujet :

Macros et VBA Excel

  1. #1
    Membre habitué
    Homme Profil pro
    Conseil en assistance à maîtrise d'ouvrage
    Inscrit en
    Septembre 2014
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Conseil en assistance à maîtrise d'ouvrage
    Secteur : Conseil

    Informations forums :
    Inscription : Septembre 2014
    Messages : 10
    Par défaut Rechercher mot dans entête et pied de page Word depuis Excel VBA
    Bonjour,

    je voudrai pouvoir rechercher la présence d'au moins un mot dans l'entête, le corps et le pied de page d'une liste de fichiers WORD stoché dans un même répertoire

    J'ai adapté, un code qui me permet de rechercher dans le corps du word mais pas dans l'entête ni me pied de page.

    En sortie, j'écris le nom du fichier, le mot recherché, un indicateur que me signale qu'il à trouvé le mot

    Merci du coup de main.

    le code actuel:

    Dim wb As Workbook 'classeur Excel dans lequel on importe les données
    Dim ws As Worksheet 'onglet Excel dans lequel on importe les données
    Dim sChemin As String 'répertoire contenant les fichiers Word
    Dim sNomFichier As String 'nom du fichier Word
    Dim WApp As Object, WDoc As Object, WSel As Object, WSel2 As Object
    Dim i As Integer
    Dim j As Integer
    Dim Max As Integer
    Dim findMe As String
    Dim Motcletrouve As Boolean


    findMe = InputBox(Prompt:=" Find a specific word ")
    Max = 2

    ' -- Variables initialisation
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1) 'on sauvegarde dans la 1re feuille
    sChemin = ChoisirRepertoire & "\" 'fonction pour choisir le répertoire contenant les fichier Word
    'sChemin = ThisWorkbook.Path & "\" 'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
    sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier.


    Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
    WApp.Visible = True 'ne pas afficher Word pendant l'exécution
    i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 '1re ligne où on va écrire les données dans le fichier Excel

    Application.ScreenUpdating = False

    ' -- Boucle sur les fichiers
    Do While Len(sNomFichier) > 0

    Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word
    'Application.StatusBar = "Écriture ligne " & i 'message dans Excel pour voir la progression

    ' Nom du fichier
    ws.Cells(i, 1) = sNomFichier
    ws.Cells(i, 2) = findMe

    ' rechercher dans corps de texte, entête et pied de page
    WApp.Selection.HomeKey Unit:=6 'Retourne au début du fichier Word
    WApp.Selection.Find.ClearFormatting 'on "vide la mémoire" de la fonction Recherche
    With WApp.Selection.Find
    .Text = findMe
    .Forward = True
    .Format = False
    '.Wrap = wdFindContinue
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    End With

    Motcletrouve = WApp.Selection.Find.Execute
    If Motcletrouve = True Then
    Cells(i, 3) = findMe & " trouvé"
    Else
    Cells(i, 3) = "RAS"
    End If

    i = i + 1 'prochaine ligne
    WDoc.Close False 'fermer le document Word sans enregistrer
    sNomFichier = Dir 'prochain document
    Loop

    SortieNormale:
    Application.ScreenUpdating = True
    WApp.Quit 'Fermer l'instance de Word
    Application.StatusBar = False 'Remise à zéro de la barre d'état
    Set wb = Nothing
    Set ws = Nothing
    Set WApp = Nothing
    Set WDoc = Nothing
    Set WSel = Nothing
    Set WApp = Nothing

    End Sub

    '====================================
    'Function to chose the folder containing the .doc files
    '====================================

    Function ChoisirRepertoire() As String
    Dim oRepertoire As Object
    ChoisirRepertoire = ""
    Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
    If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
    Set oRepertoire = Nothing
    End Function

  2. #2
    Membre expérimenté
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Janvier 2013
    Messages
    122
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Service public

    Informations forums :
    Inscription : Janvier 2013
    Messages : 122
    Par défaut
    Bonjour Ema72

    Pour rechercher dans les pieds de page :
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

    Pour rechercher dans les entêtes :
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

    La méthode Find (sur l'objet Selection) devrait fonctionner si toutefois les mots ne se situent pas dans des signets (bookmarks)

    Pour revenir au document :
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

    A tenter.

    Cdlt

Discussions similaires

  1. Réponses: 1
    Dernier message: 06/04/2022, 15h13
  2. Imprimer des pages Word depuis Excel
    Par touche_a_tout dans le forum VBA Word
    Réponses: 5
    Dernier message: 06/05/2019, 20h54
  3. Protéger une page Word depuis Excel
    Par Patouillou dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 18/02/2018, 08h57
  4. Mise en page d'un document word depuis excel VBA
    Par tinange dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 04/12/2012, 13h42
  5. pied de page word et excel ?
    Par SpaceFrog dans le forum Excel
    Réponses: 3
    Dernier message: 13/08/2007, 17h20

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo