A voir également:
- Erreur d'éxécution 5941 VBA
- Erreur 0x80070643 - Accueil - Windows
- Erreur 0x80070643 Windows 10 : comment résoudre le problème de la mise à jour KB5001716 - Accueil - Windows
- Erreur 4201 france tv ✓ - Forum Réseaux sociaux
- J'aime par erreur facebook notification - Forum Facebook
- Erreur d'execution 13 vba ✓ - Forum VB / VBA
14 réponses
Re,
Sub transfert()
dim a as string
Dim Fich As string
Fich = "formulaire"
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if sheets(Fich).Cells(num_row, i + 1) = Variables then
z= sheets(Fich).Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
sheets(fich).Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Sub transfert()
dim a as string
Dim Fich As string
Fich = "formulaire"
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if sheets(Fich).Cells(num_row, i + 1) = Variables then
z= sheets(Fich).Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
sheets(fich).Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Re,
Je t'ai modifié ta macro en ayant ton word ou ton excel à coté pour voir ce que ca fait mais je ne sais pas si ca vamarché.
Fais ton code par F
Sub transfert()
dim a as string
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("formulaire")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if Fich.Cells(num_row, i + 1) = Variables then
z= Fich.Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Je t'ai modifié ta macro en ayant ton word ou ton excel à coté pour voir ce que ca fait mais je ne sais pas si ca vamarché.
Fais ton code par F
Sub transfert()
dim a as string
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("formulaire")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if Fich.Cells(num_row, i + 1) = Variables then
z= Fich.Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Re,
et si tu fais :
Sub transfert()
dim a as string
Dim Fich As string
Set Fich = ThisWorkbook.Worksheets("formulaire")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if Fich.Cells(num_row, i + 1) = Variables then
z= Fich.Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
et si tu fais :
Sub transfert()
dim a as string
Dim Fich As string
Set Fich = ThisWorkbook.Worksheets("formulaire")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if Fich.Cells(num_row, i + 1) = Variables then
z= Fich.Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Re,
Sub transfert()
dim a as string
Dim Fich As string
Fich = activeworkbook.name
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if sheets("formulaire").Cells(num_row, i + 1) = Variables then
z= sheets("formulaire").Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
workbook(fich).activate ' si ca marche pas ecrit workbooks(fich).activate
sheets("formulaire").Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Sub transfert()
dim a as string
Dim Fich As string
Fich = activeworkbook.name
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb_Champs = 6
num_row = 1
i = 0
For i = 0 To nb_Champs - 1
if sheets("formulaire").Cells(num_row, i + 1) = Variables then
z= sheets("formulaire").Cells(num_row, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
workbook(fich).activate ' si ca marche pas ecrit workbooks(fich).activate
sheets("formulaire").Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Re,
Sub transfert()
dim a as string
Dim Fich As string
Fich = activeworkbook.name
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb = 6
num = 1
i = 0
For i = 0 To nb_Champs - 1
if sheets("formulaire").Cells(num, i + 1) = Variables then
z= sheets("formulaire").Cells(num, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num = num + 1
col = 1
For i = 0 To nb - 1
workbook(fich).activate ' si ca marche pas ecrit workbooks(fich).activate
sheets("formulaire").Cells(num, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Sub transfert()
dim a as string
Dim Fich As string
Fich = activeworkbook.name
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = "nom" & "prenom" & "nom_jeune_fille" & "sexe_M" & "sexe_F" & "lieu_naissance"
nb = 6
num = 1
i = 0
For i = 0 To nb_Champs - 1
if sheets("formulaire").Cells(num, i + 1) = Variables then
z= sheets("formulaire").Cells(num, i + 1)
end if
Next i
Set FichierWord = CreateObject("word.application")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire admission.doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num = num + 1
col = 1
For i = 0 To nb - 1
workbook(fich).activate ' si ca marche pas ecrit workbooks(fich).activate
sheets("formulaire").Cells(num, i + 1) = FichierWord.activedocument.formfields(z)
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
Re,
ca je m'en doutais un peu.
Qu'as tu voulu faire exactement?
ca je m'en doutais un peu.
Qu'as tu voulu faire exactement?
Bonjuor,
je souhaite que les valeurs de mes différents champs dans les formulaires que j'ai récupéré ce mettent dans un ficher excel en tableau pour que je puisse les traiter plus rapidement qu'à la main.
Voici ma macro telle quelle est aujourd'hui :
Sub Import_données_formulaire()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Données formulaires")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\formulaire\test\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = Array("jour_entree", "mois_entree", "annee_entree", "docteur", "hospit_complete", "ambulatoire", "htp", "soins_externes", "soins_de_suite", "chimiotherapie", "nom", "prenom", "nom_jeune_fille", "sexe_M", "sexe_F", "jour_naissance", "mois_naissance", "annee_naissance", "lieu_naissance", "departement", "adresse", "code_postal", "ville", "tel_dom", "tel_portable", "nom_pers_prevenir", "adresse_personne_pre", "tel_personne_preveni", "choix_chambre", "etablissement_exter", "date_hospit", "date_hospit2", "date_hospit3", "assurance_maladie", "num_secu", "cle_secu", "cmu_oui", "cmu_non", "mutuelle", "jour_accident", "mois_accident", "annee_accident", "employeur", "nom_assure", "prenom_assure", "nom_jeune_fille_assu", "adresse_assure", "cp_asssure", "ville_assure", "salarie", "retraite_ou_pens", "sans_emploi", "non_salarie", "non_salarie_precis", "nom_declarant", "jour_declaration", "mois_declaration", "annee_declaration")
nb_Champs = 58
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")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire_vierge[1].doc" Then
monDocument = chemin & mesfichiers
FichierWord.Documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.ActiveDocument.FormFields(Variables(i)).Result
Next i
FichierWord.Documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
J'ai une erreur à la ligne 38, c'est erreur d'éxécution 5941
le membre de la collection requis n'existe pas...
je souhaite que les valeurs de mes différents champs dans les formulaires que j'ai récupéré ce mettent dans un ficher excel en tableau pour que je puisse les traiter plus rapidement qu'à la main.
Voici ma macro telle quelle est aujourd'hui :
Sub Import_données_formulaire()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Données formulaires")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\formulaire\test\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = Array("jour_entree", "mois_entree", "annee_entree", "docteur", "hospit_complete", "ambulatoire", "htp", "soins_externes", "soins_de_suite", "chimiotherapie", "nom", "prenom", "nom_jeune_fille", "sexe_M", "sexe_F", "jour_naissance", "mois_naissance", "annee_naissance", "lieu_naissance", "departement", "adresse", "code_postal", "ville", "tel_dom", "tel_portable", "nom_pers_prevenir", "adresse_personne_pre", "tel_personne_preveni", "choix_chambre", "etablissement_exter", "date_hospit", "date_hospit2", "date_hospit3", "assurance_maladie", "num_secu", "cle_secu", "cmu_oui", "cmu_non", "mutuelle", "jour_accident", "mois_accident", "annee_accident", "employeur", "nom_assure", "prenom_assure", "nom_jeune_fille_assu", "adresse_assure", "cp_asssure", "ville_assure", "salarie", "retraite_ou_pens", "sans_emploi", "non_salarie", "non_salarie_precis", "nom_declarant", "jour_declaration", "mois_declaration", "annee_declaration")
nb_Champs = 58
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")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire_vierge[1].doc" Then
monDocument = chemin & mesfichiers
FichierWord.Documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.ActiveDocument.FormFields(Variables(i)).Result
Next i
FichierWord.Documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
End Sub
J'ai une erreur à la ligne 38, c'est erreur d'éxécution 5941
le membre de la collection requis n'existe pas...
Bonjour,
En fait, je pense que le problème vient du fait que tu veux mettre trop de variables dans variables et c pour ca que ca te fait le message d'erreur.
En fait, je pense que le problème vient du fait que tu veux mettre trop de variables dans variables et c pour ca que ca te fait le message d'erreur.
Bonjour
Tu as ouvert Word mais pas le document (le document est un membre de la collection Word)
dim WordApp as object, WordDoc as object
Set WordApp = CreateObject("word.application") 'ouvre session word
a chaque changement de document word (ta boucle)
Set WordDoc = WordApp.Documents.Open("C:\document1.doc") 'ouvre document Word
ton code
set wordDOc=nothing
Tu as ouvert Word mais pas le document (le document est un membre de la collection Word)
dim WordApp as object, WordDoc as object
Set WordApp = CreateObject("word.application") 'ouvre session word
a chaque changement de document word (ta boucle)
Set WordDoc = WordApp.Documents.Open("C:\document1.doc") 'ouvre document Word
ton code
set wordDOc=nothing
re
autre chose:
1/as tu besoin de voir les documents word puisque ton objectif est de remplir excel ?
donc FichierWord.Visible = True ralentit énormément le déroulement de la macro...
2/ FichierWord.DisplayAlerts = False est à éviter: s'il y a une alerte, il faut la gérer!
si tu es obligé de l'utiliser, IL EST IMPERATIF d'insérer dès que possible
FichierWord.DisplayAlerts = True
3/ philosophie générale VBA: Eviter les boucles sur des cellules autant que faire se peut
ainsi pour nommer tes étiquettes dans excel
par ex(demo)
ce code est beaucoup + rapide (15 à 20X) que ta boucle...
t'évite aussi de compter le nombre de colonnes...
ce nombre est correct avec les capacités actuelles des mémoires
3/ avec ton do while fichiers<>"" tu parcours ton disque dur
avant force dans ton répertoire où se trouve tes documents par
lorsque tu demandes l'ouverture du document word tu n'as pu alors qu'à indiquer le nom du doc
4/je n'ai pas compris
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire_vierge[1].doc" Then
avec le ".", "..": a quoi servent ils?
tu pourrais écrire en supposant qu'il est dans le m^dossier que tes documents
if mesfichiers <> "formulaire_vierge[1].doc" Then
Donc essaies de rectifier: il risque aussi d'y avoir un problème avec activedocument (bug word)
et il doit y avoir moyen d'être + rapide avec les reports dans excel qu'on verra après ( ma pomme ou qqn d'autre) car il y a encore beaucoup de points à améliorer
edit 13:05: modifié paragraphe 4
autre chose:
1/as tu besoin de voir les documents word puisque ton objectif est de remplir excel ?
donc FichierWord.Visible = True ralentit énormément le déroulement de la macro...
2/ FichierWord.DisplayAlerts = False est à éviter: s'il y a une alerte, il faut la gérer!
si tu es obligé de l'utiliser, IL EST IMPERATIF d'insérer dès que possible
FichierWord.DisplayAlerts = True
3/ philosophie générale VBA: Eviter les boucles sur des cellules autant que faire se peut
ainsi pour nommer tes étiquettes dans excel
par ex(demo)
Dim tablo() tablo = Array("aa", "bb", "cc") nbre = UBound(tablo) num_row = 1 i = 1 Range(Cells(num_row, i), Cells(num_row, nbre+1)) = tablo
ce code est beaucoup + rapide (15 à 20X) que ta boucle...
t'évite aussi de compter le nombre de colonnes...
ce nombre est correct avec les capacités actuelles des mémoires
3/ avec ton do while fichiers<>"" tu parcours ton disque dur
avant force dans ton répertoire où se trouve tes documents par
Chdir chemin
lorsque tu demandes l'ouverture du document word tu n'as pu alors qu'à indiquer le nom du doc
4/je n'ai pas compris
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire_vierge[1].doc" Then
avec le ".", "..": a quoi servent ils?
tu pourrais écrire en supposant qu'il est dans le m^dossier que tes documents
if mesfichiers <> "formulaire_vierge[1].doc" Then
Donc essaies de rectifier: il risque aussi d'y avoir un problème avec activedocument (bug word)
et il doit y avoir moyen d'être + rapide avec les reports dans excel qu'on verra après ( ma pomme ou qqn d'autre) car il y a encore beaucoup de points à améliorer
edit 13:05: modifié paragraphe 4
bonjour,
j'ai essayé de suivre tes conseils mais je ne sais pas faire tout ce que tu me dis donc en bidouillant ça marche mais seulement si tout mes champs sont remplis. Y a-t-il un moyen pour que si un champ reste vide ça ne plante pas le programme mais simplement qu'il n'inscrive rien dans la cellule du fichier excel?
Ci-dessous ma macro telle qu'elle fonctionne à moitié maintenant !
Sub Import_données_formulaire()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Données formulaires")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\formulaire\test\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = Array("jour_entree", "mois_entree", "annee_entree", "docteur", "hospit_complete", _
"ambulatoire", "htp", "soins_externes", "soins_de_suite", "chimiotherapie", _
"nom", "prenom", "nom_jeune_fille", "sexe_M", "sexe_F", "jour_naissance", "mois_naissance", _
"annee_naissance", "lieu_naissance", "departement", "adresse", "code_postal", "ville", _
"tel_dom", "tel_portable", "nom_pers_prevenir", "adresse_personne_pre", "tel_personne_preveni", _
"choix_chambre", "etablissement_exter", "date_hospit", "date_hospit2", "date_hospit3", "num_secu", _
"cle_secu", "cmu_oui", "cmu_non", "mutuelle", "jour_accident", "mois_accident", "annee_accident", _
"employeur", "nom_assure", "prenom_assure", "nom_jeune_fille_assu", "adresse_assure", "cp_assure", _
"ville_assure", "salarie", "retraite_ou_pens", "sans_emploi", "non_salarie_precis", "precision_non_salari", _
"nom_declarant", "jour_declaration", "mois_declaration", "annee_declaration")
nb_Champs = 57
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")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire_vierge[1].doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
Merci
j'ai essayé de suivre tes conseils mais je ne sais pas faire tout ce que tu me dis donc en bidouillant ça marche mais seulement si tout mes champs sont remplis. Y a-t-il un moyen pour que si un champ reste vide ça ne plante pas le programme mais simplement qu'il n'inscrive rien dans la cellule du fichier excel?
Ci-dessous ma macro telle qu'elle fonctionne à moitié maintenant !
Sub Import_données_formulaire()
Dim Fich As Worksheet
Set Fich = ThisWorkbook.Worksheets("Données formulaires")
chemin = "C:\Documents and Settings\stagiaire\Mes documents\Péroline\Admissions\formulaire\test\"
mesfichiers = Dir(chemin & "*.doc")
Dim Variables As Variant
Variables = Array("jour_entree", "mois_entree", "annee_entree", "docteur", "hospit_complete", _
"ambulatoire", "htp", "soins_externes", "soins_de_suite", "chimiotherapie", _
"nom", "prenom", "nom_jeune_fille", "sexe_M", "sexe_F", "jour_naissance", "mois_naissance", _
"annee_naissance", "lieu_naissance", "departement", "adresse", "code_postal", "ville", _
"tel_dom", "tel_portable", "nom_pers_prevenir", "adresse_personne_pre", "tel_personne_preveni", _
"choix_chambre", "etablissement_exter", "date_hospit", "date_hospit2", "date_hospit3", "num_secu", _
"cle_secu", "cmu_oui", "cmu_non", "mutuelle", "jour_accident", "mois_accident", "annee_accident", _
"employeur", "nom_assure", "prenom_assure", "nom_jeune_fille_assu", "adresse_assure", "cp_assure", _
"ville_assure", "salarie", "retraite_ou_pens", "sans_emploi", "non_salarie_precis", "precision_non_salari", _
"nom_declarant", "jour_declaration", "mois_declaration", "annee_declaration")
nb_Champs = 57
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")
FichierWord.Visible = True
FichierWord.DisplayAlerts = False
Do While mesfichiers <> ""
If mesfichiers <> "." And mesfichiers <> ".." And mesfichiers <> "formulaire_vierge[1].doc" Then
monDocument = chemin & mesfichiers
FichierWord.documents.Open Filename:=monDocument, ReadOnly:=True
num_row = num_row + 1
num_col = 1
For i = 0 To nb_Champs - 1
Fich.Cells(num_row, i + 1) = FichierWord.activedocument.formfields(Variables(i)).result
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit
Merci
erreur d'éxécution '5941'
erreur définie par l'application ou par l'objet
Sheets(Fich).Cells(num_row, i + 1) = FichierWord.activedocument.formfields(z)
Next i
Je ne vois pas qu'est-ce qui lui pose problème!
Merci de ton aide!!