IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Exporter tableau word vers excel [XL-365]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Futur Membre du Club
    Femme Profil pro
    Directeur technique
    Inscrit en
    Mai 2020
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Canada

    Informations professionnelles :
    Activité : Directeur technique
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2020
    Messages : 3
    Par défaut Exporter tableau word vers excel
    Bonjour,
    J'utilise VBA depuis peu. Je dois compiler plusieurs fichiers Word qui contiennent un tableau, dans un même fichier excel. Après quelques recherches, j'ai trouvé une programmation qui semble bien marcher pour toutes les cellules qui contiennent des contrôles de formulaire (merci à son auteur). Cependant, dans le tableau word, il y a des cellules qui ne contiennent que du texte et n'apparaissent pas dans mon fichier excel. J'ai fais plusieurs essais mais sans succès. Comment faire pour exporter le contenu de toutes les cellules et ce, peu importe leur format?

    Merci à l'avance

    Voici le code:
    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
    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
    'The complete VBA code to transfer data from Word forms into Excel:
    Sub getWordFormData()
    ' définir quelques variables
    Dim wdApp As New Word.Application
    Dim myDoc As Word.Document
    Dim FmFld As Word.FormField
    'Dim CCtl As Word.ContentControls
     
     
    Dim myFolder As String, strFile As String
    Dim myWkSht As Worksheet, i As Long, j As Long
    ' i pour une procédure en loop
    ' donner le chemin d'accès du dossier ou ce trouve les documents word
    myFolder = "D:\Route et PM en vigueur\Changement huile test"
    Application.ScreenUpdating = False
     
    'pour fermer la macro si le dossier est vide
    If myFolder = "" Then Exit Sub
    Set myWkSht = ActiveSheet
    'effacer les données de la feuille, pour éviter d'avoir des doublons
    'ActiveSheet.Cells.Clear
    'inscrire les cellules et textes que l'on veux pour titre de colonnes
     
    Range("B1") = "No tâche"
    Range("B1").Font.Bold = True
    Range("C1") = "No équipement"
    Range("C1").Font.Bold = True
    Range("D1") = "No moteur"
    Range("D1").Font.Bold = True
    Range("E1") = "Titre"
    Range("E1").Font.Bold = True
    Range("F1") = "Emplacement"
    Range("F1").Font.Bold = True
    Range("G1") = "Secteur"
    Range("G1").Font.Bold = True
    Range("H1") = "fréquence"
    Range("H1").Font.Bold = True
    Range("I1") = "PM"
    Range("I1").Font.Bold = True
    Range("J1") = "Pd"
    Range("J1").Font.Bold = True
    Range("K1") = "MD"
    Range("K1").Font.Bold = True
    Range("L1") = "PCE"
    Range("L1").Font.Bold = True
    Range("M1") = "Route"
    Range("M1").Font.Bold = True
    Range("N1") = "Arret"
    Range("N1").Font.Bold = True
    Range("O1") = "Marche"
    Range("O1").Font.Bold = True
    Range("P1") = "Mecanique"
    Range("P1").Font.Bold = True
    Range("Q1") = "Menuisier"
    Range("Q1").Font.Bold = True
    Range("R1") = "Électro"
    Range("R1").Font.Bold = True
    Range("S1") = "Opérateur"
    Range("S1").Font.Bold = True
    Range("T1") = "Estimation"
    Range("T1").Font.Bold = True
     
    'ca demande de compter le nb de ligne et colonne et de changer de ligne une fois la dernière colonne rempli
    i = myWkSht.Cells(myWkSht.Rows.Count, 2).End(xlUp).Row
    'pour prendre tous les documents word dans le dossier
    strFile = Dir(myFolder & "\*.doc", vbNormal)
     
    'une loop pour avoir toutes les données de tous les fichiers
    While strFile <> ""
    i = i + 1
     
    Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
     
    With myDoc
    j = 4
    'pour dire de prendre tous les controles dans le fichier ContentControls
    For Each FmFld In .FormFields
    'mets la valeur en colonne en débutant a celle spécifié par j= " " ici c'est 4 pour la 4eme colonne
    j = j + 1
    myWkSht.Cells(i, j) = FmFld.Result
    Next
    'pour que les colonnes s'ajuste au texte
    myWkSht.Columns.AutoFit
    End With
    'pour fermer le fichier et sans faire de sauvegarde
    myDoc.Close SaveChanges:=False
    strFile = Dir()
    Wend
    'pour fermer l'application word et purger les mémoires (vider presse papier)
    wdApp.Quit
    Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing
    Application.ScreenUpdating = True
    End Sub
    Fichiers attachés Fichiers attachés

  2. #2
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par BeletPic Voir le message
    Bonjour,

    Les tableaux dans les documents ne sont pas identiques en nombre de lignes. Le code ci-dessous se base sur le .docx qui ne contient pas de ligne vide.
    Ce code ne règle pas tout, notamment votre boucle For Each FmFld In .FormFields.

    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
    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
     
    Option Explicit
     
    Public MatriceInfo() As Variant
     
    Sub getWordFormData()
     
    Dim WdApp As New Word.Application
    Dim MyDoc As Word.Document
    Dim FmFld As Word.FormField
     
    Dim MyFolder As String, StrFile As String
    Dim MyWkSht As Worksheet, I As Long, j As Long
    Dim IndexMatrice  As Integer
    Dim Titre As Variant
     
        WdApp.Visible = True
        MyFolder = "D:\Route et PM en vigueur\Changement huile test"
     
        Application.ScreenUpdating = False
     
        If MyFolder = "" Then Exit Sub
     
        Set MyWkSht = ActiveSheet
     
        With MyWkSht
             Titre = Array("No tâche", "No équipement", "No moteur", "Titre", "Emplacement", "Secteur", "fréquence", "PM", "Pd", "MD", "PCE", "Route", "Arret", "Marche", "Mecanique", "Menuisier", "Électro", "Opérateur", "Estimation")
             With .Range("B1:T1")
                 .Value = Titre
                 .Font.Bold = True
             End With
             I = 2
        End With
     
        StrFile = Dir(MyFolder & "\*.doc*", vbNormal)
        While StrFile <> ""
     
              I = I + 1
     
              Set MyDoc = WdApp.Documents.Open(Filename:=MyFolder & "\" & StrFile, AddToRecentFiles:=False, Visible:=False)
     
              With MyDoc
     
                 j = 4
     
                 ChargementMatrice MyDoc
     
                 For Each FmFld In .FormFields
                     'mets la valeur en colonne en débutant a celle spécifié par j= " " ici c'est 4 pour la 4eme colonne
                     j = j + 1
                     MyWkSht.Cells(I, j) = FmFld.Result
                 Next
     
                 For IndexMatrice = LBound(MatriceInfo) To UBound(MatriceInfo)
     
                     'Debug.Print IndexMatrice & " : " & MatriceInfo(IndexMatrice)
     
                     Select Case IndexMatrice
                                Case 0   ' Tâche
                                     MyWkSht.Cells(I, 2) = Trim(Split(MatriceInfo(IndexMatrice), "No. Tâche: ")(1))
                                Case 2   ' Titre
                                     MyWkSht.Cells(I, 5) = MatriceInfo(IndexMatrice)
                                Case 12  ' Estimation
                                     MyWkSht.Cells(I, 20) = Trim(Split(MatriceInfo(IndexMatrice), " Estimation (hom.- heures):")(1))
                                Case 14  ' Equipement
                                     MyWkSht.Cells(I, 3) = MatriceInfo(IndexMatrice)
                                Case 15 ' Moteur
                                     MyWkSht.Cells(I, 4) = Trim(Split(MatriceInfo(IndexMatrice), "No. Moteur*:")(1))
                       End Select
                   Next IndexMatrice
     
                    'pour que les colonnes s'ajuste au texte
                    MyWkSht.Columns.AutoFit
                    End With
                    'pour fermer le fichier et sans faire de sauvegarde
                    MyDoc.Close SaveChanges:=False
                    StrFile = Dir()
         Wend
     
         'pour fermer l'application word et purger les mémoires (vider presse papier)
         WdApp.Quit
         Set MyDoc = Nothing: Set WdApp = Nothing: Set MyWkSht = Nothing
         Application.ScreenUpdating = True
     
         MsgBox "Fin de l'import !", vbInformation
     
    End Sub
     
    Sub ChargementMatrice(ByVal MyDoc2 As Word.Document)
     
    Dim K As Integer
     
        Erase MatriceInfo
     
        With MyDoc2.Tables(1)
             ReDim MatriceInfo(.Range.Cells.Count - 1)
             For K = 1 To .Range.Cells.Count
                 With .Range.Cells(K)
                      MatriceInfo(K - 1) = Mid(.Range.Text, 1, Len(.Range.Text) - 1)
                 End With
             Next K
        End With
     
    End Sub

  3. #3
    Futur Membre du Club
    Femme Profil pro
    Directeur technique
    Inscrit en
    Mai 2020
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Canada

    Informations professionnelles :
    Activité : Directeur technique
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2020
    Messages : 3
    Par défaut
    Bonjour Eric,
    La programmation me donne un erreur dans la section indexMatrix, à la ligne
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    MyWkSht.Cells(I, 2) = Trim(Split(MatriceInfo(IndexMatrice), "No. Tâche: ")(1))
    J'avoue ne pas tout comprendre. Trim sert a enlever les espacements inutiles, split sert a séparer la chaîne de caractère. C'est bien ca?
    Merci de votre aide.

  4. #4
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par BeletPic Voir le message
    Il faut supprimer la ligne vide (la première ligne) dans votre tableau du document .doc.
    En ce qui concerne cette formule, Split renvoie ici un tableau de deux cellules dont la première (0) serait vide. L'indice (1) indique qu'on prend la deuxième cellule. Trim purge les espaces encadrant la chaîne récupérée.

    Votre soucis sera d'avoir des tableaux aux dimensions homogènes, il vous faudra peut-être différencier les cas entre les deux types de tableaux (entre les deux il y a 3 cellules d'écart).

    Le zip contient les fichiers utilisés.

  5. #5
    Futur Membre du Club
    Femme Profil pro
    Directeur technique
    Inscrit en
    Mai 2020
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Canada

    Informations professionnelles :
    Activité : Directeur technique
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2020
    Messages : 3
    Par défaut
    Bonjour Eric,
    Merci beaucoup pour les explications. Ca clarifie le code.
    Je comprends aussi que je vais avoir beaucoup de travail afin de trier les différents document word pour avoir des groupes avec des tableaux identiques.
    Cependant, il reste un problème avec la ligne suivante.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Case 16 ' Moteur
                                     MyWkSht.Cells(I, 4) = Trim(Split(MatriceInfo(IndexMatrice), "No. Moteur*:")(1))
    J'ai regrouper quelques fichiers avec des tableaux identiques. La programmation ce déroule au complet mais il n'y a aucun no moteur qui apparaît. En changeant le 1 pour 0 à la fin, le titre "No. Moteur" ainsi que le numéro lui-même apparaissent. Ce n'est pas un gros problème, je vais le corriger avec une formule excel.

    Encore une fois, merci beaucoup pour votre aide. C'est très apprécié.

  6. #6
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par BeletPic Voir le message
    Si le nombre de lignes des tableaux est de 5 ou de 6, il suffit de tester leur nombre à l'ouverture et décaler les cellules selon les cas :
    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
    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
     
     
    Public MatriceInfo() As Variant
     
    Sub getWordFormData()
     
    Dim WdApp As New Word.Application
    Dim MyDoc As Word.Document
    Dim FmFld As Word.FormField
     
    Dim MyFolder As String, StrFile As String
    Dim MyWkSht As Worksheet, I As Long, j As Long
    Dim IndexMatrice  As Integer
    Dim Titre As Variant
     
        WdApp.Visible = True
        myFolder = "D:\Route et PM en vigueur\Changement huile test"
     
     
        Application.ScreenUpdating = False
     
        If MyFolder = "" Then Exit Sub
     
        Set MyWkSht = ActiveSheet
     
        With MyWkSht
             Titre = Array("No tâche", "No équipement", "No moteur", "Titre", "Emplacement", "Secteur", "fréquence", "PM", "Pd", "MD", "PCE", "Route", "Arret", "Marche", "Mecanique", "Menuisier", "Électro", "Opérateur", "Estimation")
             With .Range("B1:T1")
                 .Value = Titre
                 .Font.Bold = True
             End With
             I = 2
        End With
     
        StrFile = Dir(MyFolder & "\*.doc*", vbNormal)
        While StrFile <> ""
     
              I = I + 1
     
              Set MyDoc = WdApp.Documents.Open(Filename:=MyFolder & "\" & StrFile, AddToRecentFiles:=False, Visible:=False)
     
              With MyDoc
     
                 MsgBox .Tables(1).Rows.Count
     
     
                 j = 4
     
                 ChargementMatrice MyDoc
     
                 For Each FmFld In .FormFields
                     'mets la valeur en colonne en débutant a celle spécifié par j= " " ici c'est 4 pour la 4eme colonne
                     j = j + 1
                     MyWkSht.Cells(I, j) = FmFld.Result
                 Next
     
                 Select Case .Tables(1).Rows.Count
     
                        Case 5
                             For IndexMatrice = LBound(MatriceInfo) To UBound(MatriceInfo)
                                  'Debug.Print IndexMatrice & " : " & MatriceInfo(IndexMatrice)
                                  Select Case IndexMatrice
                                         Case 0   ' Tâche
                                              MyWkSht.Cells(I, 2) = Trim(Split(MatriceInfo(IndexMatrice), "No. Tâche: ")(1))
                                         Case 2   ' Titre
                                              MyWkSht.Cells(I, 5) = MatriceInfo(IndexMatrice)
                                         Case 12  ' Estimation
                                              MyWkSht.Cells(I, 20) = Trim(Split(MatriceInfo(IndexMatrice), " Estimation (hom.- heures):")(1))
                                         Case 14  ' Equipement
                                              MyWkSht.Cells(I, 3) = MatriceInfo(IndexMatrice)
                                         Case 15 ' Moteur
                                              MyWkSht.Cells(I, 4) = Trim(Split(MatriceInfo(IndexMatrice), "No. Moteur*:")(1))
                                   End Select
                              Next IndexMatrice
     
                         Case 6
                              For IndexMatrice = LBound(MatriceInfo) To UBound(MatriceInfo)
                                  'Debug.Print IndexMatrice & " : " & MatriceInfo(IndexMatrice)
                                  Select Case IndexMatrice
                                         Case 0   ' Tâche
                                              MyWkSht.Cells(I, 5) = Trim(Split(MatriceInfo(IndexMatrice), "No. Tâche: ")(1))
                                         Case 2   ' Titre
                                              MyWkSht.Cells(I, 8) = MatriceInfo(IndexMatrice)
                                         Case 12  ' Estimation
                                              MyWkSht.Cells(I, 23) = Trim(Split(MatriceInfo(IndexMatrice), " Estimation (hom.- heures):")(1))
                                         Case 14  ' Equipement
                                              MyWkSht.Cells(I, 6) = MatriceInfo(IndexMatrice)
                                         Case 15 ' Moteur
                                              MyWkSht.Cells(I, 7) = Trim(Split(MatriceInfo(IndexMatrice), "No. Moteur*:")(1))
                                   End Select
                               Next IndexMatrice
                   End Select
     
                    'pour que les colonnes s'ajuste au texte
                    MyWkSht.Columns.AutoFit
                    End With
                    'pour fermer le fichier et sans faire de sauvegarde
                    MyDoc.Close SaveChanges:=False
                    StrFile = Dir()
         Wend
     
         'pour fermer l'application word et purger les mémoires (vider presse papier)
         WdApp.Quit
         Set MyDoc = Nothing: Set WdApp = Nothing: Set MyWkSht = Nothing
         Application.ScreenUpdating = True
     
         MsgBox "Fin de l'import !", vbInformation
     
    End Sub

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2016] Tableau word vers Excel (suivant votre macro (Sub importTableWord_VersExcel())
    Par re dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 07/10/2019, 23h58
  2. Exporter Tableau Html vers Excel en UTF-8
    Par Steufa dans le forum jQuery
    Réponses: 6
    Dernier message: 15/08/2014, 11h24
  3. Réponses: 1
    Dernier message: 03/04/2012, 10h28
  4. transfert d'un tableau word vers excel en vba
    Par progaide dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 23/12/2008, 17h48
  5. Tableau word vers excel
    Par Invité(e) dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 10/10/2008, 16h22

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo