Discussion :

[infoexcel]

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 .

[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.

[infoexcel]

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)
merci d'avance

Code :

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

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

[Godzestla]

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

Une piste pour toi, pour t'apater : SPLIT

[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 :

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

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 ?

[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])

[ouskel'n'or]

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 :

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

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 :

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

    WordApp.Selection.HomeKey Unit:=wdLine

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

Code :

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

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

[infoexcel]

si j'ai compris votre explication de code :

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
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

????????????????????????????????????

[ouskel'n'or]

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

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

par

Code :

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

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
Essaie de comprendre le code, tu verras, il n'est pas si compliqué
Bonne soirée

[infoexcel]

d'accord merci alors mon code c ça

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
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 :

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

 With .Find

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

[ouskel'n'or]

Effectivement, tu as oublié un bout

Code :

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

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

[infoexcel]

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

Code :

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

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

je doit aussi faire

Code :

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

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

????????????????????????????????????

[ouskel'n'or]

oui, aussi !

[infoexcel]

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

Code :

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

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

[progaide]

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

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
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

[ouskel'n'or]

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

Code :

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

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 :

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

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 :

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

1
2
3
Debug.print "ligne = " & ligne
Debug.print "Le titre = " & LeTitre
Debug.print "NoPage = " & NoPage

Tu dis
A+

[infoexcel]

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