Décalage extraction mot clé & numéro titre

**hasgor** · 08/09/2015, 14h05

Bonjour,

J’essaie à à partir d'un caractère spécifique "[" d'extraire les paragraphes qui le contiennent ainsi que le titre de l'index et les numéros de page associés.

Mon problème actuel, est qu'il y a un décalage dans la numérotation des titres et des pages.
Quand j'ouvre mes documents words, les paragraphes sélectionnés sont correctes, il contiennent le caractère spécifique.
Mais le numéro de page et le titre de l'index associés correspondent au paragraphe suivant.

Illustration
3.1 ------
blabla []
(page 3)

le résultat va être:
3.2 blabla [] page(4)

Comment peut-on résoudre ce décalage?

Merci d'avance pour vote temps et votre aide.

La partie du code qui pose problème

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
 
        ' Sélection étendue
        Do While WApp.Selection.Find.Execute = True
            j = j + 1
            WApp.Selection.Expand wdSentence
            Set WSel = WApp.Selection
            ' Extract
            ws.Cells(j, 2) = WSel
 
            WApp.Selection.collapse Direction:=0
            ' Titre
            ws.Cells(j, 4) = WApp.Selection.Range.ListFormat.ListString
            ' Numéro de page
            ws.Cells(j, 5) = WApp.Selection.Information(wdActiveEndPageNumber)            
            ' Nom du fichier
            ws.Cells(j, 6) = sNomFichier
        Loop

Le code en entier.

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
75
76
77
78
79
80
81
82
83
84
85
86
 
Public Sub Import_Data()
 
    ' -- Variables declaration
    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 findMe As String
    'Dim wdActiveEndPageNumber As Variant
 
 
    'findMe = InputBox(Prompt:=" Find a specific word ")
     findMe = "["
 
    'Enregistrement du mot-clé dans la variable globale
    kword = findMe
 
    ' -- 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
    j = 2
 
    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
 
        'ws.Cells(i, 2) = findMe
 
        ' Recherche  (par la fonction FIND)
        WApp.Selection.HomeKey unit:=wdStory, Extend:=wdExtend
        'WApp.Selection.HomeKey unit:=6                                       'Retourne au début du fichier Word
 
        WApp.Selection.Find.ClearFormatting                                  
        With WApp.Selection.Find
            .Text = findMe
            .Forward = True
            .Format = False
            .MatchCase = True                                   
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
 
        ' Sélection étendue
        Do While WApp.Selection.Find.Execute = True
            j = j + 1
            WApp.Selection.Expand wdSentence
            Set WSel = WApp.Selection
            ' Extract
            ws.Cells(j, 2) = WSel
 
            WApp.Selection.collapse Direction:=0
            ' Titre
            ws.Cells(j, 4) = WApp.Selection.Range.ListFormat.ListString
            ' Numéro de page
            ws.Cells(j, 5) = WApp.Selection.Information(wdActiveEndPageNumber)            
            ' Nom du fichier
            ws.Cells(j, 6) = sNomFichier
        Loop
 
        i = i + 1                             'prochaine colonne
        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

Cordialement,
Hasgor

**clementmarcotte** · 08/09/2015, 22h00

Bonjour,

L'as-tu juste exécuté au pas-à-pas, en vérifiant visuellement où se trouve le point d'insertion dans Word et dans la valeur des variables après chaque ligne de code pour être sûr que le problème est vraiment dans la "lecture" dans Word et pas dans l'affichage dans Excel ?

As-tu vérifié si tes J prennent vraiment la bonne valeur et pas une valeur trop élevée.

Dans VBA les collections débutent à l'indice 0 (zéro).

**hasgor** · 09/09/2015, 09h41

Bonjour,

J'ai lancé le code en pas à pas, ce qui a été très intéressant.

La valeur de ma variable j est correcte.

Le problème vient du faite que ma ligne de code suivante était mal placé

Code :

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

1
2
 
WApp.Selection.collapse Direction:=0

Le numéro de page est maintenant correcte.

Par conte bizarrement, les titres n'apparaissent plus....

Code :

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

 ws.Cells(j, 6) = WApp.Selection.Range.ListFormat.ListString

Avez-vous une solution?

**clementmarcotte** · 09/09/2015, 19h40

Bonjour,

Envoyé par hasgor

Bonjour,

Par conte bizarrement, les titres n'apparaissent plus....

Code :

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

 ws.Cells(j, 6) = WApp.Selection.Range.ListFormat.ListString

Avez-vous une solution?

Range.text ne serait pas suffisant ?

**hasgor** · 10/09/2015, 11h54

Range.text ne serait pas suffisant ?

Range.text me donne le même résultat que ma sélection étendue = une phrase.

J'ai l'impression que la méthode suivante fonctionne mais j'ai un problème de sélection.

Code :

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

Selection.Range.ListFormat.ListString

Si je fais un :

Code :

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

.Collapse Direction:=0

La méthode ListString me sort le numéro d'index suivant.

Si je ne met rien d'autre que ma sélection.find.... le résultat est vide

Est-ce qu'il existe une méthode pour récupérer le titre avant la sélection?
Soit à partir d'un style d'écriture soit à partir de la table des matières comme tous les titres sont indexés.

**clementmarcotte** · 10/09/2015, 20h05

Bonjour,

Envoyé par hasgor

Range.text me donne le même résultat que ma sélection étendue = une phrase.

Est-ce qu'il existe une méthode pour récupérer le titre avant la sélection?
Soit à partir d'un style d'écriture soit à partir de la table des matières comme tous les titres sont indexés.

Là, je n'ai pas trop le temps de regarder en profondeur, mais tu peux boucler sur la collection des styles et récupérer les noms de styles, mais, je ne suis pas sur que tu puisses récupérer le texte correspondant.

Mais tu aurais probablement plus de chance en essayant ceci. En principe, si tes textes numérotés sont une seule phrase, ou un seul paragraphe, tu peux boucler sur la collection sentences (phrases) ou la collection paragraphs (paragraphes) du document. Rendu là, tu peux vérifier le style de ton paragraphe et récupérer le texte.

**hasgor** · 18/09/2015, 10h44

Bonjour,

Je reviens vers vous car je bloque toujours au même point...
J'ai réussi à extraire le numéro de titre ainsi que le texte associé mais je reste bloqué dans la sélection, les données sont dans la variable r.

Et j'ai l'impression de mettre embrouillé. Je pense qu'il y a une histoire de boucle mais je ne sais pas trop comment faire n'étant pas un expert en programmation...

L'idéal serait qu'après chaque extraction de la sélection je passe au titre suivant.

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
            Do While WApp.Selection.Find.Execute = True                      ' Boucle sur la sélection
                j = j + 1
 
                WApp.Selection.Expand wdParagraph                        'Étend la sélection à une phrase
                Set WSel = WApp.Selection
 
 
                ws.Cells(j, 3) = WSel                                        ' Phrase contenant la sélection
                ws.Cells(j, 5) = WSel.Information(wdActiveEndPageNumber)     ' Numéro de page
                ws.Cells(j, 7) = sPropriete1 & " - " & sPropriete2 & " - " & _
                                 sPropriete3 & " - " & sPropriete4           ' Concaténation des propriétés personnalisées
 
                 Set r = WSel.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious)
                 r.Expand Unit:=wdSentence
                 MsgBox r.ListFormat.ListString & r.Text
 
                r.Collapse Direction:=0
                WSel.Collapse Direction:=0

Décalage extraction mot clé & numéro titre

VBA Word

Discussions similaires

Partager

Partager