[VBA-E]Formulaire word, récupérer les données dans excel

Version imprimable

25/05/2006, 23h55
sablier

[VBA-E]Formulaire word, récupérer les données dans excel

Bonjour,

J'ai réalisé un formulaire word avec word 2003.

Je vais envoyer ce formulaire à plusieurs dizaines de personnes afin de pouvoir récupérer des informations.

Je souhaiterais pouvoir automatiser la récupération des informations contenues dans ce formulaire word. L'objectif est de récupérer ces informations dans un tableau excel.

Comment procéder ? Où me renseigner ?

Je ne connais rien à vba.

Par avance merci pour tout lien ou suggestion de lectures
25/05/2006, 23h59
Vesta

JE te suggère de faire un tableau dans word contenant les réponses au questions du formulaire ce qui limitera déja les zones de réponses possible et donc les contraintes liées a la recherche de celles ci...

Lorsque ce tableau sera pret joint le a la discution, je regarderai comment récupérer les données y étant incules par une procédure écrite en VBA Excel et on en reparle...
26/05/2006, 00h05
sablier

Citation:

Envoyé par Vesta

JE te suggère de faire un tableau dans word contenant les réponses au questions du formulaire ce qui limitera déja les zones de réponses possible et donc les contraintes liées a la recherche de celles ci...

Lorsque ce tableau sera pret joint le a la discution, je regarderai comment récupérer les données y étant incules par une procédure écrite en VBA Excel et on en reparle...

Je ne suis pas certain d'avoir compris. Pour te faire une idée tu as besoin d'un tableau présentant un exemple des données que je collecte avec ce formulaire ? Pour chaque champ du formulaire j'ai mis un signet. Faut-il indiquer le signet ?
26/05/2006, 00h21
Vesta

Donne moi un exemple de formulaire exactement comme tu l'as fais signet tout le bazrd
26/05/2006, 00h32
sablier

1 pièce(s) jointe(s)

Exemple formulaire

Citation:

Envoyé par Vesta

Donne moi un exemple de formulaire exactement comme tu l'as fais signet tout le bazrd

Voici en pièce jointe le formulaire que j'ai élaboré.

Si tu peux m'aiguiller vers une solution afin de pouvoir récupérer ces informations dans un tableau excel.

Par avance merci

Sablier
26/05/2006, 00h34
Vesta

Bien sur je regarde ca tu as de mes nouvelles demain

1 pièce(s) jointe(s)

Voila j'ai joint mon fichier Excel destiné a l'importation.

Il faut placer tout les doc dans le meme répertoire.
Tu peux aussi bien sur t"amuser a le faire un par un mais bon ca je ne sais pas alors tu verra bien sur le moment...

Si tu veux que l'ordre des colonnes change dans Excel il faudra faire un controle a chaque nom de signet et assigner un No de colonne a celui ci.

Ici je les ai pris dans l'ordre lu par Excel... Je ne sais pas si cela te convient...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ' Vérifie que l'on a bien affaire a un document Word If Right(varFiles(IndexFichier), 4) = ".doc" Then 'Ouvre le fichier Word Set WordDoc = WordApp.Documents.Open(DocPath & varFiles(IndexFichier)) 'j es l'index de colonne j = 0 'Parcoure tout les signets du document For Each Bmk In WordDoc.Bookmarks j = j + 1 'Met la valeur du Signet dans la cellule Data.Cells(i, j) = Bmk.Range.Text Next i = i + 1 'Ferme le fichier Word WordDoc.Close End If
Pour ceux que ca intéresse...

26/05/2006, 08h32
sablier

Merci.

Je vais regarder cela plus précisément ce soir car je suis un peu pris aujourd'hui.

Si j'ai bien compris :
les intitulés des colonnes de la feuille 2 sont extraits automatiquement du formulaire à partir du bouton de commande sur la feuille 1.
Chaque formulaire apparaîtra sur une ligne dans la feuille 2
le répertoire où se trouvent les formulaires est indiqué dans la cellule qui se trouve sur la feuille 1
Si je veux obtenir ces formulaires dans un certain ordre il faut que j'ordonne mes signets avant en choisissant des noms adaptés.

Merci pour ton aide !

PS : j'ai un message d'alerte d'excel quand j'ouvre ton fichier. Il désactive la macro. Comment activer les macros ?
26/05/2006, 09h19
SfJ5Rpw8

Citation:

Envoyé par sablier

PS : j'ai un message d'alerte d'excel quand j'ouvre ton fichier. Il désactive la macro. Comment activer les macros ?

Voir menu Excel Outils/Macro/sécurité/NiveauSécurité ... bon moi je fonctionne en niveau moyen... si tu ve utiliser le niveau haut... utilise selfcert.exe qui doit être présent sur ton répertoire application office...
26/05/2006, 11h02
Vesta

Tu as bien compris si tu as un autre prob n'hésite pas... En ce qui concerne la sécurité, On t'a donné une réponses assez claire je pense.
26/05/2006, 23h40
sablier

Je viens d'essayer ton fichier d'import. C'est stupéfiant et presque parfait.

J'ai seulement un problème avec l'import des données provenant d'une liste déroulante ou d'une case à cocher.

S'il s'agit d'un nombre ou de texte l'import se réalise parfaitement.

Une idée ?

Sablier
27/05/2006, 00h59
Vesta

Oui ca doit venir du
Bmk.Range.Text

Je n'ai pas eu le temps de tout tester, il faudrait voire si il y a des types de signet aussi, et voire quelle autre méthode permettrai de récupérer l'info...
27/05/2006, 20h00
sablier

Quelqu'un a une idée permettant de récupérer les données issues d'un formulaire et provenant d'une liste déroulante ou d'une case à cocher ?

Sablier
27/05/2006, 20h06
SfJ5Rpw8

bon j'ai pas le temps ce soir... mais penche toi du coté de la collection fields.. de ton document word..
27/05/2006, 23h34
sablier

bbil et ouskel'n'or :

Je n'ai pas compris ce que vous vouliez dire.

Je ne vois pas ce que peut être la collection fields du document word et j'ignore où trouver la barre de menu "Commandes"

Pour faire mon formulaire j'ai utilisé la barre d'outils formulaires.

en fait c'est FormFields... tiens remplace la boucle For Each du code à vesta par :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Dim f As FormField
For Each bmk In WordDoc.Bookmarks
     'Met la valeur du Signet dans la cellule
    If bmk.Range.FormFields.Count = 0 Then
        j = j + 1
          Data.Cells(i, j) = bmk.Range.Text
    Else
      For Each f In bmk.Range.FormFields
       j = j + 1
        Data.Cells(i, j) = f.Name & " .. : " & f.Result
     Next
    End If
Next

Merci.

J'ai intégré ton bout de code. La macro tourne mais le résultat n'est pas encore parfait.

Cette fois ci je parviens à récupérer les données issues de cases à cocher et de listes déroulante. Par contre, les données se trouvent mêlées avec le nom du signet.

Par exemple dans une cellule j'ai :

DateFin .. : 02/09/2006

DateFin est le nom du signet et 02/09/2006 est ma donnée.

Je pense que l'on est pas trop loin de la solution ! :lol:

Voici le code dans sa globalité :

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
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' Parcoure le dossier strDirPath et renvoie un tableau contenant
    ' Le nom de tout les fichers dans le répertoire
 
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long
 
    On Error GoTo GetAllFiles_Err
 
    ' Vérifie que le caractère de fin est bien un '\'
    If Right$(strDirPath, 1) <> "\" Then
        strDirPath = strDirPath & "\"
    End If
 
    ' Vérifie que c'est bien un dossier
    If GetAttr(strDirPath) = vbDirectory Then
        strTempName = Dir(strDirPath, vbDirectory)
        Do Until Len(strTempName) = 0
            ' Exclu ".", "..".
            If (strTempName <> ".") And (strTempName <> "..") Then
                ' Vérifie que ce n'est pas un sous répertoire
                If (GetAttr(strDirPath & strTempName) _
                    And vbDirectory) <> vbDirectory Then
                    ' Redimensionne le tableau
                    ReDim Preserve varFiles(lngFileCount)
                    varFiles(lngFileCount) = strTempName
                    lngFileCount = lngFileCount + 1
                End If
            End If
            ' Utilise Dir pour trouver le fichier suivant
            strTempName = Dir()
        Loop
        ' Renvoie le tableau contenant les ficheirs trouvés
        GetAllFilesInDir = varFiles
    End If
GetAllFiles_End:
    Exit Function
GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function
 
Private Sub StartImport_Click()
Dim WordApp As New Word.Application
Dim WordDoc As New Word.Document
Dim Bmk As Word.Bookmark
Dim DocPath As String
Dim varFiles As Variant
Dim IndexFichier As Long
Const NO_FILES_IN_DIR As Long = 9
Const INVALID_DIR As Long = 13
 
On Error GoTo Test_Err
 
'Prend la valeur du répertoire ou sont stockés les documents
DocPath = Main.Range("PathSource").Value
 
'Peu etre a améliorer pour déterminer la premiere ligne ou écrire les valeurs
i = 2
 
    'Récupere la liste des documents du répertoire
    varFiles = GetAllFilesInDir(DocPath)
    For IndexFichier = 0 To UBound(varFiles)
        ' Vérifie que l'on a bien affaire a un document Word
        If Right(varFiles(IndexFichier), 4) = ".doc" Then
            'Ouvre le fichier Word
            Set WordDoc = WordApp.Documents.Open(DocPath & varFiles(IndexFichier))
             'j es l'index de colonne
             j = 0
            'Parcoure tout les signets du document
                Dim f As FormField
                For Each Bmk In WordDoc.Bookmarks
                     'Met la valeur du Signet dans la cellule
                     If Bmk.Range.FormFields.Count = 0 Then
                          j = j + 1
                          Data.Cells(i, j) = Bmk.Range.Text
                       Else
                          For Each f In Bmk.Range.FormFields
                               j = j + 1
                               Data.Cells(i, j) = f.Name & " .. : " & f.Result
                          Next
                     End If
                Next
            'Ferme le fichier Word
            WordDoc.Close
        End If
    Next IndexFichier
 
'Ferme Word
WordApp.Quit
 
Exit Sub
 
Test_Err:
    Select Case Err.Number
        Case NO_FILES_IN_DIR
            MsgBox "Le répertoire '" & strDirName _
                & "' ne contient aucun fichier."
        Case INVALID_DIR
            MsgBox "'" & DocPath & "' n'es pas un répertoire valide."
        Case 0
        Case Else
            MsgBox "Error #" & Err.Number & " - " & Err.Description
    End Select
WordDoc.Close
WordApp.Quit
 
End Sub

28/05/2006, 20h35
SfJ5Rpw8
ben c'est cette ligne ..
Code:

1 2 Data.Cells(i, j) = f.Name & " .. : " & f.Result
qui concaténe le nom du champ ,F.name
avec les données qu'il contient...

faut voir ce que tu ve comme résultat.. ?
28/05/2006, 21h47
sablier

En fait, j'aimerais avoir une première ligne avec les signets (cela représentera mes intitulés de colonne). Pour les lignes suivantes, j'aimerais avoir les données collectées via le formulaire (uniquement sans le nom du signet puisqu'il serait déjà sur la première ligne).

Une idée ? :D

Sablier
30/05/2006, 00h43
sablier

Avec cette dernière modification je récupère uniquement les données du formulaire.

Le seul bémol c'est que je n'ai plus les signets sur une première ligne. Pour autant ce n'est pas très grave pour ce que je veux faire. Je peux me débrouiller autrement.

Une solution pourrait consister à intégrer un autre bouton me permettant de récupérer d'abord les signets. Le second bouton servirait à récupérer les données.

Encore merci à vous tous.
30/05/2006, 07h38
SfJ5Rpw8
dans la mesure ou tes signets sont les mêmes pour tous les formulaires.. tu peu les mettre lors du traitement du premier fichier..
Code:

1 2 3 4 5 6 7 8 For Each f In Bmk.Range.FormFields j = j + 1 Data.Cells(i, j) =f.Result if IndexFichier =0 then Data.Cells(1, j) = f.Name Next ....