Erreur d'éxécution 5941 VBA

pero -  
Bonjour,
j'ai créé une macro :
Sub transfert()
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 = Array("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
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 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(Variables(i)).result
Next i
FichierWord.documents.Close (0)
End If
mesfichiers = Dir
Loop
FichierWord.Quit

End Sub

lorsque je la lance j'obtins un msg d'erreur : erreur d'éxécution 5941 : erreur définie par l'application ou par l'objet

Qu'est-ce que ça veut dire??!!

Merci pour vos réponses
Configuration: Windows XP Internet Explorer 7.0

14 réponses

Résumé de la discussion

Plusieurs contributeurs du fil analysent une macro VBA nommée transfert qui doit remplir Excel à partir de champs Word, mais déclenche des erreurs d'exécution 5941. Les causes principales concernent des références d'objet incorrectes (Sheets(Fich), Fich mal défini) et l'accès direct aux formfields via Variables sans correspondance exacte. Les corrections suggérées incluent déclarer Fich comme Worksheet, protéger Variables comme tableau de chaînes et assurer une indexation fiable des cellules et des champs du document. Des conseils pratiques ajoutent le débogage pas à pas, éviter d'afficher Word, et optimiser la boucle par des structures plus efficaces.

Bobot (l’IA à votre service)
  1. melanie1324
    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
    1
    1. pero
      j'ai à nouveau le msg d'erreur suivant :
      erreur d'éxécution '5941'
      erreur définie par l'application ou par l'objet
      0
    2. pero
      @perol'erreur se situe entre les deux lignes suivantes (31 et 32) :

      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!!
      0
  2. melanie1324
    Bonjour,

    Lorsque tu as ce message, tu cliques sur déboggage, sur quelle ligne se positionne t il?
    0
    1. pero
      il ne me dit pas à quelle ligne ça bloque. Quand je fais débogage pas à pas il s'arrête dès la première ligne
      0
  3. melanie1324
    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
    0
    1. pero
      il ne se passe rien...
      0
  4. melanie1324
    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
    0
    1. pero
      Re,
      à la ligne 4 il me dit :
      erreur de compilation
      objet requis
      il n'a pas aimé la modif de Worksheet en String...
      0
  6. melanie1324
    Re,

    j'ai boulié :
    Set Fich = "formulaire"
    0
    1. pero
      j'ai qd même le msg d'erreur de compilation : incompatibilité de type
      0
    2. pero
      @peropardon le msg est : erreur de compilation : objet requis!
      0
  7. melanie1324
    Re,

    alors écrit :
    fich = "formulaire"
    0
    1. melanie1324
      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
      0
      1. pero
        Nouvelle erreur :

        erreur d'éxécution '9'
        l'indice n'appartient pas à la selection
        0
    2. melanie1324
      Re,

      Fais le par F8 et dis moi ou ca bloque encore.

      Courage, on va y arriver.
      0
      1. pero
        entre les lignes 15 et 16
        If Sheets("formulaire").Cells(num_row, i + 1) = Variables Then
        z = Sheets("formulaire").Cells(num_row, i + 1)

        merci bcp
        0
    3. melanie1324
      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
      0
      1. pero
        il n'y a plus d'erreur mais rien ne s'affiche...
        0
    4. melanie1324
      Re,

      ca je m'en doutais un peu.

      Qu'as tu voulu faire exactement?
      0
      1. pero27
        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...
        0
    5. melanie1324
      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.
      0
      1. pero27
        existe-t-il une solution pour qd même pouvoir récupérer toutes ces variables?
        0
    6. michel_m Contributeur
      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
      0
      1. michel_m Contributeur
        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) 
        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
        0
        1. pero27
          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
          0
      2. michel_m Contributeur
        Je n'y vois aucun changement
        J'ai passé 3/4 heure à essayer de t'aider en t'expliquant: tout ça pour que dalle!
        Ciao
        --
        0

        Discussions similaires

        erreur 5941
        isa

        15 réponses
        erreur 5941
        omar_einstein

        27 réponses
        fichier word erreur d execution 5941
        arianefurer

        11 réponses