Récupération de champs d'un formulaire avec macro excel

Résolu/Fermé
Signaler
Messages postés
3
Date d'inscription
mardi 1 octobre 2013
Statut
Membre
Dernière intervention
9 octobre 2013
-
Messages postés
1
Date d'inscription
lundi 21 novembre 2016
Statut
Membre
Dernière intervention
21 novembre 2016
-
bonjour,

j'ai créer une fiche de renseignements avec word (sous forme de formulaire) que des étudiants doivent remplir. Les champs renseignés sont récupérer grâce à une macro dans un fichier excel.
ma macro fonctionne bien avec excel 2003 mais ne fonctionne plus avec excel 2010.
J'ai un message qui m'indique que le fichier word est vérouillé pour modification (ce qui est normal pour les formulaire).

J'avoue que je ne trouve pas de solutions, si un aimable internaute peut jeter un coup d'oeil et m'aider a contourner ce probleme.

ci après le code vba

Dim NumCol As Integer
Sub Recup_Infos_Etudiant()

'
' Recup_Infos_Etudiant Macro
' Macro enregistrée le 05/07/2012 par MP Infal
' Charge la feuille "BD" à partir des champs de tous les documents ".doc" se
' trouvant dans le même répertoire que le document Excel

On Error GoTo Trt_Err

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim abookmark As Bookmark
Dim NomRep As String, VarFic As String
Dim ChListe As FormField
Dim CtrCol As Integer

NomRep = ThisWorkbook.Path
Application.Cursor = xlWait
VarFic = Dir(NomRep & "\*.doc")
Set wrdApp = CreateObject("Word.Application")
CtrFic = 0
'msgbox ("Lancement winword==")
Do While Len(VarFic) > 0
'msgbox ("fic : " & VarFic & "==")
wrdApp.Visible = False
VarDoc = NomRep & "\" & VarFic
CtrFic = CtrFic + 1
Set wrdDoc = wrdApp.Documents.Open(VarDoc)
i = 1
Worksheets("BD").Cells(CtrFic + 1, 1).Value = VarFic

If ActiveDocument.FormFields.Count >= 1 Then
For Each ChListe In ActiveDocument.FormFields
appel = Boucle_Nom_Champs(ActiveDocument.FormFields(i).Name)
Worksheets("BD").Cells(1, NumCol).Value = ActiveDocument.FormFields(i).Name
Worksheets("BD").Cells(CtrFic + 1, NumCol).Value = ActiveDocument.FormFields(i).Result
i = i + 1
Next ChListe
End If
ActiveDocument.Close
VarFic = Dir()
Loop
Application.Cursor = xlDefault
wrdApp.Quit
'Affichage du message de fin correcte

msg = "Chargement terminé correctement" ' Définit le message.
Style = vbYesOnly ' Définit les boutons.
Titre = "BD_Prepa " ' Définit le titre.
Reponse = msgbox(msg, Style, Titre)
Exit Sub

Trt_Err: ' Routine de gestion d'erreur.

Application.Cursor = xlDefault
If Err.Number = 462 Then
wrdApp.Quit
End If
'Affichage du message de fin incorrecte

msg = "Erreur - l'application Excel va quitter, vous devez relancer votre classeur Excel" ' Définit le message.
Style = vbYesOnly ' Définit les boutons.
Titre = "BD_Prepa " ' Définit le titre.
Style = vbYesOnly + vbCritical + vbDefaultButton2 ' Définit les boutons.
Title = "BD_Prepa : Erreur - Fin prématurée du programme " ' Définit le titre.
Reponse = msgbox(msg, Style, Titre)
Application.Quit
ThisWorkbook.Close SaveChanges:=False

End Sub
Function Boucle_Nom_Champs(NomChamp)

Dim NomRep As String, VarFic As String

For i = 2 To 110
If Worksheets("Nom_Signet").Cells(i, 1).Value = NomChamp Then
NumCol = i
Exit Function
End If
Next


End Function
Sub test()

' Macro1 Macro
' Macro enregistrée le 05/07/2012 par MP Infal
' Boucle sur les signets


Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim abookmark As Bookmark
Dim NomRep As String, VarFic As String
Dim ChListe As FormField
Dim CtrCol As Integer

NomRep = ThisWorkbook.Path

VarFic = Dir(NomRep & "\*.doc")
Set wrdApp = CreateObject("Word.Application")
CtrFic = 0
Do While Len(VarFic) > 0
wrdApp.Visible = False
VarDoc = NomRep & "\" & VarFic
CtrFic = CtrFic + 1
Set wrdDoc = wrdApp.Documents.Open(VarDoc)
i = 1
Worksheets("BD").Cells(CtrFic + 1, 1).Value = VarFic

If ActiveDocument.Bookmarks.Count >= 1 Then
ReDim aMarks(ActiveDocument.Bookmarks.Count - 1)
i = 0
Worksheets("BD").Cells(CtrFic + 1, 1).Value = VarFic
For Each abookmark In ActiveDocument.Content.Bookmarks
CtrCol = i + 1
Worksheets("BD").Cells(1, CtrCol + 1).Value = abookmark.Name
Worksheets("BD").Cells(CtrFic + 1, CtrCol + 1).Value = abookmark.Range.Text
If abookmark.Name = "Texte16" Or abookmark.Name = "Texte22" Then
Debug.Print ("Fichier : " & VarFic & "numéro " & i & "nom : " & abookmark.Name & " = " & abookmark.Range.Text & " ==")
End If
i = i + 1
Next abookmark
' Debug.Print ("nb bookmars " & i & "==")
End If
ActiveDocument.Close
VarFic = Dir()
Loop
wrdApp.Quit

End Sub

MERCI BEAUCOUP

ANNAROL

8 réponses

Messages postés
16121
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
30 novembre 2021
1 563
Bonjour,

j'ai créer une fiche de renseignements avec word (sous forme de formulaire)

Vous pourriez mettre un fichier doc avec des renseignements bidons a dispo sur

https://www.cjoint.com/

n'oubliez pas de copier/coller le lien cree dans votre prochain message

A+
bonsoir ami internaute,

je vous ai mis le document word pour vous donner une idée sur quoi je travaille....

http://cjoint.com/?CJbtMqYc5wu

merci de votre aide,

annarol
Messages postés
16121
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
30 novembre 2021
1 563
Re,

essayez avec le fichier ci-dessous:

https://www.cjoint.com/c/CJbvU6PjI8z

A+
Messages postés
1
Date d'inscription
lundi 21 novembre 2016
Statut
Membre
Dernière intervention
21 novembre 2016

pourai-je avoir un tuto pour l'utilisation svp
ok merci je vais essayez ce matin

je vous tiens au courant

annarol
bonsoir ami internaute,

Alors j'ai testé ta macro. 1ere chose, elle disparait lorsque je l'ouvre avec excel 2010 ! C'est étrange,non ? Alors je l'ai ouvert dans excel 2003 et j'ai copié ton code puis recolé dans 2010.
2me chose, il ouvre bien word 2010 et là j'ai toujours le message qui me dit que le fichier est vérouillé par le propriétaire etc... Je clique sur ok, il charge le fichier, récupére les données et les injecte dans excel.

Donc il y a de l'amélioration mais lorsque vous avez 1000 élèves à rentrer j'ai pas envie de passer mon temps à cliquer sur oui pour chacun...

Je me demande si il n'y a pas une config à changer dans word 2010, je cherche mais je ne trouve pas.

Si tu as la soluce, je suis preneur et moi de mon coté je cherche toujours.

merci à toi ami internaute

annarol
Messages postés
16121
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
30 novembre 2021
1 563
Bonjour,

Chez moi, je n'ai pas de message "fichier verrouille", meme si le fichier est ouvert.

ajoutez cette ligne de code pour invalider les alertes Excel, apres les declaration de variables:

Application.DisplayAlerts = False

A+
Messages postés
3
Date d'inscription
mardi 1 octobre 2013
Statut
Membre
Dernière intervention
9 octobre 2013

ok je vais le faire ce week end et vous tiens au courant dès lundi.

bon week end

annarol
Messages postés
3
Date d'inscription
mardi 1 octobre 2013
Statut
Membre
Dernière intervention
9 octobre 2013

bonjour ami internaute,

j'ai testé et tout est ok, je te remercie beaucoup pour le coup de main.

bonne continuation

annarol