Discussion :

[Kestion100]

Bonjour,
J'ai mis au point fichier excel me permettant de remonter les valeurs inscrites dans les champs de formulaires word, jusque là, aucun problème.

Le problème est que j'ai 124 champs et je me rends comptes que l'ordre de mes titres de colonnes ne correspond pas à l'ordre de récupération des champs, pour régler ce problème, je souhaiterais récupérer les noms de mes champs pour qu'ils s'inscrivent des mes titres de colonnes dans le bonne ordre.

En gros, si un code équivalent à celui permettant de récupérer les valeurs des champs d'une formulaire word dans des cellules excel pouvait me permettre de récupérer les noms même de ces mêmes champs cela m’ôterait une grosse épine du pied.

J'ai trouvé ce code sur le forum:

Code :

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

NomChamp = ActiveDocument.Bookmarks(Selection.BookmarkID).Name

mais je n'ai aucune idée pour l'intégrer dans un code pour ouvrir un seul fichier word donné et récupérer tous les noms de ses champs.

Mon code pour récupérer les valeurs des champs:

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
54
55
56
Sub RECUPCOLLES()
Dim Fich As Worksheet, Ligne As Long
Set Fich = ThisWorkbook.Worksheets("RECUP")
Sheets("RECUP").Visible = True
Worksheets("RECUP").Activate
'ActiveSheet.Unprotect
 
Chemin = "H:\secretariat\2014 2015\outils generaux\colleurs\declarations\"
mesfichiers = Dir(Chemin & "*.doc*")
'Dim Variables As Variant
'Variables = Array("NOM", "Prénom", "Sexe", "Datedenaissance", "Père", "Mère", "Autre", "NOMRESPLEG", "PNOMRESPLEG", "Résidence", "CHEZ", "ADRESSE", "CODEPOSTAL", "COMMUNE", "Tél", "NIV", "SPE", "NIVV1", "SPEV1", "NIV1", "SPE1", "NIV2", "SPE2", "NIV3", "SPE3", "UEP2A", "EPLEACONTACTER", "EPLEACONTACTERV1", "EPLEACONTACTERV2", "EPLEACONTACTERV3", "CIO")
 
 
'nb_Champs = 32
'num_row = 1
'i = 0
 
'For i = 0 To nb_Champs - 1
  'Fich.Cells(num_row, i + 1) = Variables(i)
'Next i
 
Set FichierWord = CreateObject("word.application")
'Set WordDoc = WordApp.Documents.Open(mesfichiers)
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
 
Do While mesfichiers <> ""
  If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "clients.doc" Then
    monDocument = Chemin & mesfichiers
    FichierWord.Documents.Open Filename:=monDocument, ReadOnly:=True
    Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
    Ligne = ActiveCell.Row
    'num_row = num_row + 1
    'num_col = 1
    'For i = 0 To nb_Champs - 1
    For i = 1 To 124
    'Range("A2").End(xlDown).Offset(1, 0).Select
    'Fich.Cells(num_row, i + 1) = FichierWord.ActiveDocument.FormFields(i).Result
    Cells(Ligne, i) = FichierWord.ActiveDocument.FormFields(i).Result
    Next i
    'FichierWord.Documents.Close (0)
   ' FichierWord.Documents.Close 'False 'ferme le document Word sans sauvegarde
 'ferme l'application Word
  End If
  mesfichiers = Dir
Loop
FichierWord.Quit
'Calculate
'ActiveSheet.Protect
CopierFichierDECLARES
COPYPASTESEL
'ActiveSheet.Range("F2", ActiveSheet.Range("DU2").End(xlDown)).Select
'Selection.Copy
'ActiveSheet.Paste
 
End Sub

que j'ai tenté d'adapter:

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
54
55
56
57
58
59
60
Sub NOMSCHAMPS()
 
 
 
Dim Fich As Worksheet, Ligne As Long
Set Fich = ThisWorkbook.Worksheets("STATS")
Sheets("STATS").Visible = True
Worksheets("STATS").Activate
'ActiveSheet.Unprotect
 
Chemin = "H:\secretariat\2014 2015\outils generaux\colleurs\declarations\"
mesfichiers = Dir(Chemin & "*.doc*")
'Dim Variables As Variant
'Variables = Array("NOM", "Prénom", "Sexe", "Datedenaissance", "Père", "Mère", "Autre", "NOMRESPLEG", "PNOMRESPLEG", "Résidence", "CHEZ", "ADRESSE", "CODEPOSTAL", "COMMUNE", "Tél", "NIV", "SPE", "NIVV1", "SPEV1", "NIV1", "SPE1", "NIV2", "SPE2", "NIV3", "SPE3", "UEP2A", "EPLEACONTACTER", "EPLEACONTACTERV1", "EPLEACONTACTERV2", "EPLEACONTACTERV3", "CIO")
 
 
'nb_Champs = 32
'num_row = 1
'i = 0
 
'For i = 0 To nb_Champs - 1
  'Fich.Cells(num_row, i + 1) = Variables(i)
'Next i
 
Set FichierWord = CreateObject("word.application")
'Set WordDoc = WordApp.Documents.Open(mesfichiers)
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
 
Do While mesfichiers <> ""
  If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "clients.doc" Then
    monDocument = Chemin & mesfichiers
    FichierWord.Documents.Open Filename:=monDocument, ReadOnly:=True
    Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
    Ligne = ActiveCell.Row
    'num_row = num_row + 1
    'num_col = 1
    'For i = 0 To nb_Champs - 1
    For i = 1 To 124
    'Range("A2").End(xlDown).Offset(1, 0).Select
    'Fich.Cells(num_row, i + 1) = FichierWord.ActiveDocument.FormFields(i).Result
    'FichierWord.ActiveDocument.FormFields(i).Result
    Cells(Ligne, i) = FichierWord.ActiveDocument.Bookmarks(Selection.BookmarkID).Name
    Next i
    'FichierWord.Documents.Close (0)
   ' FichierWord.Documents.Close 'False 'ferme le document Word sans sauvegarde
 'ferme l'application Word
  End If
  mesfichiers = Dir
Loop
FichierWord.Quit
'Calculate
'ActiveSheet.Protect
'CopierFichierDECLARES
'COPYPASTESEL
'ActiveSheet.Range("F2", ActiveSheet.Range("DU2").End(xlDown)).Select
'Selection.Copy
'ActiveSheet.Paste
 
End Sub

Sans succés

[Kestion100]

Trouvé:

Code :

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

FichierWord.ActiveDocument.FormFields(i).Result

devient:

Code :

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

FichierWord.ActiveDocument.FormFields(i).Name