Récupération de données Word dans Excel en VBA

Version imprimable

07/01/2009, 11h22
infoexcel

1 pièce(s) jointe(s)

Récupération de données Word dans Excel en VBA

Bonjour
J’ai besoin d’aide svp j’ai un exercice c’est un sommaire dans un document Word et je voudrais le copier dans un fichier Excel par un programme vba :
Exemple des données en Word :

Acquisition du langage oral : repères chronologiques [5]
Apprentissage de la lecture [33]
Apprentissage de la production écrite et de l’orthographe [79]
Apprentissage de l’arithmétique [107]
Apprentissage du langage écrit chez les sourds [137]

Le résultat dans Excel

5 \ Acquisition du langage oral : repères chronologiques
33 \ Apprentissage de la lecture
79 \ Apprentissage de la production écrite et de l’orthographe
107 \ Apprentissage
137 \ Apprentissage du langage écrit chez les sourds

Svp comment je peux le faire dans un programme en vba pour
Prendre les numéros de la page qui sont entre [ ] et le copier dans la 1ère colonne et de prendre le titre de la page par exemple ici « Acquisition du langage oral : repères chronologiques »et le copier dans la colonne accoter de sont numéro de page.
dans la pièce jointe vous trouvez un exemple de mon sommaire word
Merci d’avance .
07/01/2009, 12h10
Jannus

Bonjour,

Ce que tu nous proposes là, c'est de résoudre ton exercice à ta place, ce qui est contraire à l'esprit et aux règles du forum ;)

Plutôt que de nous donner l'énoncé de ton exercice, montre-nous le travail déjà effectué et explique-nous clairement sur quoi tu butes.

non c'est pas ça .ça fait 3 semianes maintenant que je cherche j'ai fais un petit programme pour ouvrire le document word apartire d excel mais je me suis bloqué sur comment je peux faire pour que ce programme prend les chiffres qui sont entre [1]et les mettre dans une colonne et prendre le texte et le mettre devant ce chiffre.je sais que je peux le faire si j'ai des données dans un tableau word mais ici j'ai selment des titres et a la fin j'ai le numéro de la page entre [ ].j'ai essayer pas male de fois . je voudrais pas que vous me realisez cette exercice mais de m'aider (je suis debutante) :cry:
merci d'avance
Code:

1 2 3 4 5 6 7 8 9 10 Sub Macro1() Dim WordApp As Word.Application Dim WordDoc As Word.Document Dim ligne As Long Set WordApp = CreateObject("word.application") Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\hh.doc") WordApp.Visible = False 'Word est masqué pendant l'opération N_lignes = WordDoc.Paragraphs.Count

07/01/2009, 12h27
Godzestla

.... mais pourquoi alors nous cacher ton code......????? :mrgreen:

Une piste pour toi, pour t'apater : SPLIT
07/01/2009, 13h00
ouskel'n'or

Les caractères [ et ] sont des balises qui vont te permettre de retrouver les N° de pages. Tu as un exemple ici de ce que tu peux faire (forum Contribuez-Word)
Pour utiliser "Selection", il suffit que tu le précèdes de WordApp

Code:

WordApp.selection... etc

Pour les titres : S'agit-il des titres dans le sens de "Word" -> Titre 1, Titre 2, etc. ? Ou simplement du texte mis en forme ?
07/01/2009, 13h04
infoexcel

merci pour vous mais vraiment j'ai pas bien compris je suis debutante ds le vba .c'est simplement du texte par exemple
(Acquisition du langage oral : repères chronologiques [ 5])

Donc tu n'as rien pour désigner la ligne, si ce n'est [ ... ]
Pour sélectionner du texte dans Word, le principe consiste à trouver le début, puis à "étendre" la sélection à la fin du texte à l'aide de ExtendMode :
Code:

1 2 3 4 5 6 'Aller au début du titre With Selection .ExtendMode = True 'Aller à la fin du texte LeTexte = Application.selection End with
Juste pour le principe.
Dans ton cas, si tu dois récupérer le titre, tu dois, dans l'ordre :
- Rechercher la ligne contenant le caractère "[" (code ds l'url que je t'ai passée)
- Récupérer le N° de page entre les crochets (code ds l'url que je t'ai passée en ajoutant WordApp. avant Selection
- Pour le titre, aller en début de ligne

Code:

WordApp.Selection.HomeKey Unit:=wdLine

Et enfin retourner sur le crochet "[" en étendant la sélection.
Code:

1 2 3 4 5 6 7 8 9 10 With WordApp.Selection .ExtendMode = True With .Find .Text = "[" .Forward = True .Execute End With LeTitre = Left(WordApp.Selection.Text, Len(WordApp.Selection.Text) - 1) .ExtendMode = False End with
Il te reste à comprendre le code de l'url, à tenter de te débrouiller avec ces indications... et éventuellement à revenir nous décrire les problèmes que tu rencontres... avec le code que tu utilises ;)
Bon courage

si j'ai compris votre explication de code :

Code:

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
WordApp.Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            With .Find
                .Text = "["
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "]"
                    .Forward = True
                    .Execute
                End With
                MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
    Loop
         WordApp.Selection.HomeKey unit:=wdLine
           With WordApp.Selection
                .ExtendMode = True
                With .Find
                    .Text = "["
                    .Forward = True
                    .Execute
                End With
                LeTitre = Left(WordApp.Selection.Text, Len(WordApp.Selection.Text) - 1)
                .ExtendMode = False
        End With

:( ????????????????????????????????????

07/01/2009, 19h36
ouskel'n'or

Oui, à première vu ça "y" ressemble... :aie:
Remplace

Citation:

MsgBox Mid(Selection.Text, 2, Len(Selection.Text) - 2)

par

Code:

NoPage = Mid(Selection.Text, 2, Len(Selection.Text) - 2)

vérifie ce que tu as dans les variables NoPage et LeTitre et il ne te restera plus qu'à les placer là où tu veux qu'ils soient dans Excel.
Si je te fais tout, je vais réclamer ta paye et tu ne seras pas content :mouarf:
Essaie de comprendre le code, tu verras, il n'est pas si compliqué ;)
Bonne soirée

d'accord merci alors mon code c ça

Code:

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
Sub Macro1()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ligne As Long
 
Set WordApp = CreateObject("word.application")    'ouvre une session Word
Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\Bureau\Nouveau dossier (3)\exemple en word.doc")    'ouvre le document Word
WordApp.Visible = False    'Word est masqué pendant l'opération
 
WordApp.Selection.HomeKey unit:=wdStory
    Do While Not fin
        With Selection
            With .Find
                .Text = "["
                .Execute
                .Forward = True
                fin = .Found = False
            End With
            .ExtendMode = True
            If Not fin Then
                With .Find
                    .Text = "]"
                    .Forward = True
                    .Execute
                End With
                NoPage = Mid(Selection.Text, 2, Len(Selection.Text) - 2)
                .ExtendMode = False
                .MoveRight unit:=wdWord, Count:=1
            End If
        End With
    Loop
         WordApp.Selection.HomeKey unit:=wdLine
           With WordApp.Selection
                .ExtendMode = True
                With .Find
                    .Text = "["
                    .Forward = True
                    .Execute
                End With
                LeTitre = Left(WordApp.Selection.Text, Len(WordApp.Selection.Text) - 1)
                .ExtendMode = False
        End With
     Cells(ligne, 1) = NoPage ' enregistrement dans Excel
     Cells(ligne, 2) = LeTitre
 
WordApp.Visible = True    'affiche le document Word
 
WordDoc.Close False 'ferme le document word en sauvegardant les données
WordApp.Quit 'ferme la session Word
End Sub

mais il me donne un debogage ici

Code:

With .Find

et l'aide ici ça marche pas je ne sais pas pourquoi ????

08/01/2009, 10h36
ouskel'n'or
Effectivement, tu as oublié un bout
Code:

1 2 3 Do While Not fin With WordApp.Selection With .Find
N'oublie pas que tu es dans Excel. Chaque fois que tu exécutes une instruction Word, tu dois le préciser.
"Do While Not fin" -> La boucle est dans Excel
"With Selection" -> C'est dans Word donc... ici la sélection s'applique à l'application, donc "with WordApp.Selection"

A très bientôt ;)
Bon courage
08/01/2009, 11h11
infoexcel

oui merci pour l'explication c'est vrai ça marcher mais es que ici

Code:

NoPage = Mid(Selection.Text, 2, Len(Selection.Text) - 2)

je doit aussi faire

Code:

NoPage = Mid(WordApp.Selection.Text, 2, Len(WordApp.Selection.Text) - 2)

????????????????????????????????????
08/01/2009, 13h38
ouskel'n'or

oui, aussi ! :mouarf:
08/01/2009, 15h42
infoexcel
merci ça marche bien mais la partie copier sur excel ça marche pas il me donne un debigage ici
Code:

1 2 Cells(ligne, 1) = NoPage ' enregistrement dans Excel Cells(ligne, 2) = LeTitre

salut peut etre se programme t'aide un peut a resoudre votre excercice

Code:

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
Sub Sommaire()
 
With ActiveSheet.QueryTables.Add(Connection:= _
  "TEXT;Disque Dur:Users:francois:Desktop:exemple en word.doc", Destination:= _
    Range("A1"))
  'Tu devras remplacer par ton chemin d'accès
  .Name = "exemple en word"
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .RefreshOnFileOpen = False
  .BackgroundQuery = True
  .RefreshStyle = xlOverwriteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = xlWindows
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierDoubleQuote
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = True
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = False
  .TextFileSpaceDelimiter = False
  .TextFileOtherDelimiter = "["
  .TextFileColumnDataTypes = Array(1, 1)
  .Refresh BackgroundQuery:=False
  .UseListObject = False
End With
i = 1
Do Until Left(Cells(i, 1), 6) Like "MSWord"
  If Right(Cells(i, 2), 1) <> "]" Then
    Cells(i, 2).EntireRow.Delete
  Else
    i = i + 1
  End If
Loop
Cells(i, 1).EntireRow.Delete
Cells(1, 1).Select
Position = InStr(1, Selection, 1, 1) - 1
Selection.Replace What:=Left(Cells(1, 1), Position), Replacement:="", LookAt:=xlPart, _
  SearchOrder:=xlByColumns, MatchCase:=True
Columns("B:B").Select
Selection.Replace What:="]", Replacement:="", LookAt:=xlPart, _
  SearchOrder:=xlByColumns, MatchCase:=True
Columns("A:A").Cut Destination:=Columns("C:C")
Columns("A:A").Delete Shift:=xlToLeft
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").HorizontalAlignment = xlRight
Range("A1").Select
End Sub

09/01/2009, 09h26
ouskel'n'or
Citation:
Envoyé par infoexcel

merci ça marche bien mais la partie copier sur excel ça marche pas il me donne un debigage ici

Code:

1 2 Cells(ligne, 1) = NoPage ' enregistrement dans Excel Cells(ligne, 2) = LeTitre
As-tu vérifié ce qu'il y a dans NoPage ?
Si oui et si tu es certain d'avoir quelque chose dans "ligne", teste en ajoutant value et le nom de la feuille

Code:

Worksheets("Lafeuille").cells(NoLig, 2).value = NoPage

Tu peux aussi vérifier tes variables en affichant la fenêtre exécution (éditeur VBA -> Affichage -> Fenêtre exécution) et en insérant ces lignes avant celles qui buggent.
Code:

1 2 3 Debug.print "ligne = " & ligne Debug.print "Le titre = " & LeTitre Debug.print "NoPage = " & NoPage
Tu dis
A+
14/01/2009, 10h01
infoexcel

d'accord merci ça marche tr bien merci une autre fois :D