Macro pour exporter des données sur WORD vers Excel (version 2007)

Version imprimable

Voir 40 message(s) de cette discussion en une page

29/10/2012, 19h48
SfJ5Rpw8

Citation:

Envoyé par krokos55

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

oui
29/10/2012, 21h24
Daniel.C

Bonsoir,

Il y a incrément de "i" quand on passe sur un titre ayant une parenthèse en fin de numérotation : "1)" par exemple. Si le commentaire est avant, effectivement, "i" est peut-être à 0. Il faudrait savoir s'il y a systématiquement un commentaire et si il est avant le premier niveau de titre.
Mets en pièce jointe les documents promis. Comme je ne reproduis pas les caractères parasites, mets dans le classeur Excel une feuille où ils figurent. Ça ne doit pas être compliqué de les supprimer.
29/10/2012, 21h30
SfJ5Rpw8

Citation:

Envoyé par krokos55

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

applique ta fonction remplace à tous tes :

Code:

Paragraphe.Range.Text

;)
30/10/2012, 10h27
Daniel.C

Pour supprimer les caractères parasites, mets, en fin de macro :

Code:

Cells.Replace Chr(13), "", xlPart
31/10/2012, 09h04
krokos55

2 pièce(s) jointe(s)

Bonjour,

Merci pour vos réponses

1- En ce qui concerne le symbole parasite, avec la ligne de Daniel en fin de macro, ça fonctionne , merci bcp, je l'ai donc intégré dans le code.

2- ci joint les documents à date, ou il y a toujours le pb de " commentaire".
Effectivement il y a toujours une/plusieurs lignes de commentaires qui commencent toujours par " Commentaire:" (cf le doc word ci joint) et qui se situent toujours après les différentes options de réponses possibles et avant la question suivante (comme c'est le cas dans le doc word ci joint)

Attention petit détail: L'idéal serait d'avoir :
Pour une question 1): (ligne 1, colonne 1)
Réponse A. (ligne 1, colonne 2)
Réponse B. (ligne 1, colonne 3)
Réponse C. (ligne 1, colonne 4)
Le texte du commentaire (ligne 1, colonne 5) mais sans copier dans la cellule le début du paragraphe " Commentaire:", mais uniquement la phrase de commentaire.
exemple : "Commentaire: bla bla bla"
On ne copie pas dans la cellule " Commentaire: bla bla bla " mais uniquement "Bla bla bla"

Merci pour votre aide

Bonjour,

Essaie :

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
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
 
 
Sheets.Add After:=Sheets(Sheets.Count)
 
    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
                End If
                ElseIf Left(Paragraphe.Range.Text, 12) = "Commentaire:" Then
                    Commentaire = Paragraphe.Range.Text
                     col = col + 1
                     Cells(i, col) = Commentaire
 
            End If
        End With
 
    Next
 
 
 
Cells.Replace Chr(13), "", xlPart
 
    Set docWord = Nothing
    Set appWrd = Nothing
End Sub

Si ça fonctionne à ton idée, il ne te restera plus qu'à à définir la largeur des colonnes et à mettre le renvoi à la ligne automatique.

31/10/2012, 13h10
krokos55

C'est parfait Daniel, cela répond tout à fait au problème

J'ai juste rajouté un Mid pour n'extraire que la phrase de commentaire sans répéter "Commentaire".

Merci bcp pour le boulot, c'est super

Voir 40 message(s) de cette discussion en une page