Discussion :

[krokos55]

Bonjour a tous,

Je cherche à créer une macro excel qui me permet d'importer sur une feuille excel des données word sur le format suivant:

Sur une feuille word, j'ai un Quizz composé de plusieurs questions :

1) Intitulé de la question 1 ......bla bla bbla.......................
........................ (saut de ligne)

a) Réponse a
b) Réponse b
c) Réponse c

2) Intitulé de la question 2 ......bla bla bbla.......................
........................ (saut de ligne)

a) Réponse a
b) Réponse b
c) Réponse c

Toutes les question sont sur ce format (même si certaines question ont un énoncé de 1 ligne, 2 ligne 3 lignes) et les réponses possibles sont au nombre de 3 ou 4 ...

La bonne réponse est surlignée en jaune

L'idée est de créer un tableau excel qui comporte (i) 7 colonnes par exemple :

Colonne 1 : Intitulé de la question
Colonne 2 : Réponse a
Colonne 3 : 1 si réponse a correcte 0 sinon
Colonne 4 : Réponse b
Colonne 5: 1 si réponse b correcte 0 sinon
Colonne 6 : Réponse c
Colonnes 7: 1 si réponse c correcte 0 sinon

Et (ii) autant de lignes qu'il y a de questions.

J'espère que j'ai été assez précis et clair , ça me rendrait vraiment service car il y a quelques dizaines de questions à la suite dans le document word

Merci bcp pour votre aide par avance

[Daniel.C]

Bonjour,

Regarde cette page :

http://excel.developpez.com/faq/?page=Word

[kiki29]

Salut, voir ici ?

[krokos55]

Bonjour Daniel,

Merci pour ta réponse c'est un bon début,
En effet la macro qui est dispo sur ton lien:

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
Sub ExportWord()
 
    'necessite d'activer la reference
        '"Microsoft Word xx.x Object Library"
    Dim AppWord As Object
    Dim docWord As Object
    Dim Paragraphe As Object
    Dim i As Integer
 
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    Set docWord = appWrd.Documents.Open("C:\Documents and Settings\e.level\Bureau\macro Niko\NCordisco_inclassactivities_session13")
 
    For Each Paragraphe In docWord.Paragraphs
        If Paragraphe.Range.ListFormat.ListValue <> 0 Then
            i = i + 1
            Cells(i, Paragraphe.Range.ListFormat.ListLevelNumber) = _
                Paragraphe.Range.ListFormat.ListString
            Cells(i, Paragraphe.Range.ListFormat.ListLevelNumber + 1) = _
                Paragraphe.Range.Sentences(1).Text
        End If
    Next
 
End Sub

me permet de copier dans excel ligne après ligne tous les paragraphes
1)
a)
b)
2)
a)
b)
....

Toutefois, je cherche à les disposer dans excel de cette façon là:

Ligne 1: Colonne 1: Intitulé de la Question 1)
Ligne 1: Colonne 2: Intitulé Réponse possible a) à la Question 1)
Ligne 1: Colonne 3: 1 si la Réponse possible a) à la Question 1) est de format "surligné en jaune sinon 0
Ligne 1: Colonne 4: 1 énoncé de la Réponse possible b) à la Question 1)
etc...

Ainsi, à partir du code, je ne sais pas comment disposer correctement les données car je ne sais pas faire de différence dans la macro entre les paragraphes 1), 2) etc... et les sous paragraphes a), b) c) ...

D'autre part, tous les sauts de lignes dans word apparaissent sous forme d'un point d'interrogation encadré dans le doc excel ...

Merci

[Daniel.C]

Je suis loin d'être un pro dans le pilotage de Word. Est-ce que tu pourrais mettre en pièce jointe un document exemple, sans données confidentielles ?

[krokos55]

Ci joint

- Un doc word type avec 2 questions par exemple
- Un doc excel avec:
sur la première page le résultat de la macro (cf mon post précédent)
et en feuil2, le résultat que j'aimerai obtenir de façon automatique

Merci bcp !!

[kiki29]

Salut, il faudrait que ton doc Word comporte des Signets ou au minimum des Champs pour faciliter grandement la chose

[krokos55]

Oui je me doute !
Mais c'est pas le cas car le doc word existe deja sans signet...

En revanche, l'opération peut , peut être , être faite en plusieurs étapes:
a partir du doc excel que j'ai envoyé, il y a sur une page une première extraction
est il possible ensuite de répartir proprement cette Feuil1 sur la Feuil2 avec une boucle du type:

for i = 2 to fin
si la colonne A affiche x) alors mettre dans la ligne x de la Feuil2

for j = i to i+4 (car on sait que les réponses possibles A, B ou C ou D sont situé dans les lignes juste en dessous
exemple sur l'excel: Question 2) à la ligne 5 , et les réponses possibles sont au lignes 6, 7 ou 8

si la colonne A affiche A. mettre dans la même ligne (sur la Feuil2) que la Question, à la colonne B D ou F selon que ce soit la réponse a), b) ou c) ou d)?

Vous croyez que c'est possible ?
merci à vous

[kiki29]

Re,

Oui je me doute !
Mais c'est pas le cas car le doc word existe deja sans signet...

Raison de plus pour le metre à jour et éviter le bricolage.

[krokos55]

Mais comment est il possible de mettre des signets rapidement sur une feuille word qui contient 300 questions à choix multiples?

[Daniel.C]

Essaie comme ceci :

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
Sub ExportWord()
 
    'necessite d'activer la reference
        '"Microsoft Word xx.x Object Library"
    Dim AppWord As Object
    Dim docWord As Object
    Dim Paragraphe As Object
    Dim i As Integer
 
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    'Set docWord = appWrd.Documents.Open("C:\Documents and Settings\e.level\Bureau\macro Niko\Exemple questions")
    Set docWord = appWrd.Documents.Open(ThisWorkbook.Path & "\kroko55 Exemple questions")
    For Each Paragraphe In docWord.Paragraphs
        With Paragraphe.Range.ListFormat
            If .ListValue <> 0 Then
               If Right(.ListString, 1) = ")" Then
                    i = i + 1
                    col = 1
                    Cells(i, 1) = .ListString & " " & Paragraphe.Range.Text
                ElseIf Right(.ListString, 1) = "." Then
                    'Cells(i, 2) = Paragraphe.Range.Sentences(1).Text
                    col = col + 1
                    Cells(i, col) = .ListString & " " & Paragraphe.Range.Text
                    If Paragraphe.Range.HighlightColorIndex = 7 Then
                        Cells(i, col).Interior.ColorIndex = 6
                    End If
                End If
            End If
        End With
    Next
    Set docWord = Nothing
    Set appWrd = Nothing
End Sub

[kiki29]

Re,

Mais comment est il possible de mettre des signets rapidement sur une feuille word qui contient 300 questions à choix multiples?

A la base Il s'agit d'une erreur de conception et donc pas de bras pas de chocolat

[krokos55]

Daniel, c'est génial ! Merci bcp

Juste un point: Comment pourrait on enlever la création d'un carré avec un point d’interrogation en bout de phrase dans les cellule excel:
Ils correspondent au renvoi à la ligne dans word ....

[Daniel.C]

Je n'ai pas ce que tu signales. Regarde mon classeur joint. Toutefois, j'utilise Excel 2010 ?

[krokos55]

C'est en raison de ma version d'excel 2007
en fait c'est lié au renvoi à la ligne
Je peux le supprimer en faisant cette manip :

Code :

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

Range("A1") = Replace(Replace(Range("A1"), Chr(10), ""), Chr(13), "")

Deux dernières petites questions et le pb sera parfaitement résolu:

1- Comment généraliser la formule ci dessus à l'ensemble des cellules ?
2- En exportant le word dans le texte, il y a une petite chose que j'ai oublié, c'est que entre les questions il y a une ligne qui commence toujours par
Commentaire: blabla bla

Est il possible d'insérer dans la marco une extraction de la phrase "blabla" à la suite de la dernière colonne de réponse c) (en tronquant "Commentaire:" )

Pour une question donné on aurait colonne 1 : la question, colonnes 2,3,4 les réponses possibles et colonne 5 la phrase de commentaire ?

Merci bcp !

[Daniel.C]

Pour une question donné on aurait colonne 1 : la question, colonnes 2,3,4 les réponses possibles et colonne 5 la phrase de commentaire ?

Je n'ai pas testé mais ça devrait fonctionner avec le code 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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub ExportWord()
 
    'necessite d'activer la reference
        '"Microsoft Word xx.x Object Library"
    Dim AppWord As Object
    Dim docWord As Object
    Dim Paragraphe As Object
    Dim i As Integer
    Dim Commentaire As String
 
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    'Set docWord = appWrd.Documents.Open("C:\Documents and Settings\e.level\Bureau\macro Niko\Exemple questions")
    Set docWord = appWrd.Documents.Open(ThisWorkbook.Path & "\kroko55 Exemple questions")
    For Each Paragraphe In docWord.Paragraphs
        With Paragraphe.Range.ListFormat
            If .ListValue <> 0 Then
               If Right(.ListString, 1) = ")" Then
                    i = i + 1
                    col = 1
                    Cells(i, 1) = .ListString & " " & Paragraphe.Range.Text
                ElseIf Right(.ListString, 1) = "." Then
                    'Cells(i, 2) = Paragraphe.Range.Sentences(1).Text
                    col = col + 1
                    Cells(i, col) = .ListString & " " & Paragraphe.Range.Text
                    If Paragraphe.Range.HighlightColorIndex = 7 Then
                        Cells(i, col).Interior.ColorIndex = 6
                    End If
                ElseIf Left(Paragraphe.Range.Text, 12) = "Commentaire:" Then
                    Commentaire = Paragraphe.Range.Text
                End If
            End If
        End With
        col = col + 1
        Cells(i, col) = Commentaire
    Next
    Set docWord = Nothing
    Set appWrd = Nothing
End Sub

[krokos55]

Lorque je le fais tourner ca bug " Erreur 1004"
sur la partie de code suivante: Cells(i, col) = Commentaire

[Daniel.C]

Ça peut être plusieurs choses. Peux-tu mettre un document de test en PJ ?

[SfJ5Rpw8]

Bonsoir,

2 Choses, tout d'abords il faut éviter d'utiliser un objet tel que cells,range... sans préciser feuille et classeur..

Ensuite vérifie la valeur de i lorsque ta fenêtre de debug apparaît. En cliquant sur le bouton continuer puis en plaçant le curseur de ta souris sur ta variable.....

[krokos55]

Bonjour à tous,

1- Tout d'abord, voici en pj les deux documents tests

2- Ensuite voici ci dessous le code que j'utilise:

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
Sub ExportWord()
 
    'necessite d'activer la reference
        '"Microsoft Word xx.x Object Library"
    Dim AppWord As Object
    Dim docWord As Object
    Dim Paragraphe As Object
    Dim i As Integer
    Dim Commentaire As String
    Dim o As Range
 
    Set appWrd = CreateObject("Word.Application")
    appWrd.Visible = True
    'Set docWord = appWrd.Documents.Open("C:\Documents and Settings\e.level\Bureau\macro Niko\Exemple questions")
    Set docWord = appWrd.Documents.Open(ThisWorkbook.Path & "\Exemple questions v2")
    For Each Paragraphe In docWord.Paragraphs
        With Paragraphe.Range.ListFormat
            If .ListValue <> 0 Then
               If Right(.ListString, 1) = ")" Then
                    i = i + 1
                    col = 1
                    Cells(i, 1) = .ListString & " " & Paragraphe.Range.Text
                ElseIf Right(.ListString, 1) = "." Then
                    'Cells(i, 2) = Paragraphe.Range.Sentences(1).Text
                    col = col + 1
                    Cells(i, col) = .ListString & " " & Paragraphe.Range.Text
                    If Paragraphe.Range.HighlightColorIndex = 7 Then
                        Cells(i, col).Interior.ColorIndex = 6
                    End If
                ElseIf Left(Paragraphe.Range.Text, 12) = "Commentaire:" Then
                    Commentaire = Paragraphe.Range.Text
                End If
            End If
        End With
        col = col + 1
        Cells(i, col) = Commentaire
    Next
 
 'Cette boucle a pour objectif de supprimer les points d'interrogation dans les carrés - symbole d'un renvoi à la linge => mais elle ne marche pas !
 
For Each o In Selection
s = o.Value
o.Value = Replace(Replace(s, Chr(10), ""), Chr(13), "")
Next
 
 
    Set docWord = Nothing
    Set appWrd = Nothing
End Sub

3- effectivement, lors du debug, le i indique 0! ce qui est bizarre il faudrait incrémenter i sur 1 au minimum non?

4- Dernier point enfin, à propos d'un symbole qui apparait dans mes cellules excel (2007), lié aux renvois à la ligne dans le doc word (cela crée des petit carrés avec des point d'interrogation dedans ), j'ai essayer de généraliser une boucle qui supprime cela mais elle ne fonctionne pas... Si vous pouviez jeter un coup d’œil ce serait formidable !
PS: j'arrive à supprimer sur une seule cellule le symbole avec remplace Ch(13) par "" mais je n'arrive pas à généraliser...

merci bcp pour votre aide