Créer une macro de fichiers word vers excel [résolu]

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 6 octobre 2017, 09:22

Salut

en ce qui concerne le nom et le numéro de dossier. oui c'est possible sans pb.
je te répondrai ce soir.
en ce qui concerne les lignes vides, il faut que tu te référes à la réponse de NCC 1701.
qui vérifie si la colonne 1 et 2 sont vides.
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 8 octobre 2017, 20:39

Salut,

Voici le code avec la solution de NCC 1701 pour ne récupérer que les lignes non vides et avec l'ajout du numéro de dossier et du nom et prénom avant le tableau.
Sub ImportWord()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Chemin As String, Fichier As String, Valeur As String
Dim NumDossier As String, ID As String
Dim i As Integer, j As Integer, p As Integer

p = 0
Chemin = "P:\Donnees\Windows2012R2\Bureau\Travail sur IMC\"   'chemin où se trouve des fichiers
'----------------------------------------------------
'Boucle sur tous les fichiers doc du répertoire
'----------------------------------------------------
Fichier = Dir(Chemin & "*.docx")
Set WordApp = CreateObject("word.application")
WordApp.Visible = True    'Word reste affiché pendant l'opération /  Tu peux en mettant False masqué word pour + de rapidité
Do While Len(Fichier) > 0
    NumDossier = Left(Fichier, Len(Fichier) - 5) 'Nom du fichier sans l'extention
    NumDossier = Trim(Right(NumDossier, Len(NumDossier) - InStr(1, NumDossier, "N°") - 1))
    ID = Trim(Mid(Fichier, InStr(1, Fichier, "-") + 1, (Len(Fichier) - InStr(1, StrReverse(Fichier), "-")) - InStr(1, Fichier, "-")))
    Set WordDoc = WordApp.Documents.Open(Chemin & "\" & Fichier)
    p = p + 1
    Cells(p, 1).Value = "Dossier N°: " & NumDossier
    Cells(p, 2).Value = "Nom et Prénom : " & ID
    For i = 1 To WordDoc.Tables(1).Rows.Count
        p = p + 1
        For j = 1 To WordDoc.Tables(1).Columns.Count
            Valeur = Application.WorksheetFunction.Clean(WordDoc.Tables(1).Columns(j).Cells(i).Range.Text)
            If j = 1 And Valeur = "" Then
                If Application.WorksheetFunction.Clean(WordDoc.Tables(1).Columns(2).Cells(i).Range.Text) = "" Then
                    GoTo Suite
                Else
                    Cells(p, j).Value = Valeur
                End If
            Else
                Cells(p, j).Value = Valeur
            End If
        Next j
    Next i
Suite:
    WordDoc.Close    'fermeture document Word
    Fichier = Dir()   'récupére le nom du prochain fichier
Loop
WordApp.Quit    'fermeture session Word
       
End Sub
N
NCC 1701
Membre fidèle
Membre fidèle
Messages : 450
Inscrit le : 4 septembre 2016
Version d'Excel : 95..2013 PC FR

Message par NCC 1701 » 9 octobre 2017, 00:41

Bonjour (..)

@Jers19

Merci de prendre mon code en poursuite de ton travail, je crois que notre ami boltu n'avais pas vu cette proposition, qui me semble être la seule solution pour lire correctement son tableau depuis Word ;;)

Bonne poursuite dans ce fil, en tout cas je reste avec vous si tu veux bien, car "pour une fois" c'est un fil qui change un peu de l'ordinaire des questions... ;;)
Cordialement
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 9 octobre 2017, 11:27

Merci à vous deux pour vos réponses :D
La macro semble bien fonctionner
J'ai voulu rajouter des fichiers dans mon dossier source

Et un message d'appel s'affiche: "argument ou appel de procédure incorrect", du coups ca bloque à un moment
Dois je vérifier dans les nouveaux fichiers rajoutés s'il n'y a pas un truc qui ferais bugger?
(à priori j'ai regardé les 2 fichiers avant après ou la page s'arrête je ne vois pas d'anomalies)
Bonne journée!
Modifié en dernier par boltu le 9 octobre 2017, 14:31, modifié 1 fois.
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 9 octobre 2017, 12:29

Salut

A quel niveau le code plante t'il ?

NCC 1701
Pas de problème. Ravi de travailler en collaboration avec toi :D
N
NCC 1701
Membre fidèle
Membre fidèle
Messages : 450
Inscrit le : 4 septembre 2016
Version d'Excel : 95..2013 PC FR

Message par NCC 1701 » 9 octobre 2017, 13:36

Bonjour

Et surtout montre nous tes "ajouts" ;;)
Cordialement
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 9 octobre 2017, 14:33

Alors en gros en enlevant/ajoutant les fichiers, cela ne change rien, j'ai l'impression qu'il bug toujours vers la ligne 66.
En gros mes "ajouts" était de rajouter des fichiers du même type en plus.
J'ai d'abord fait la macro avec 150 documents, cela a marché
puis j'ai rajouté 70 documents et là il ne semble plus content...

EDIT: en fait tout bêtement un nom de fichier était au format différent, je suis ne train de voir mais cela semble mieux fonctionner
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 9 octobre 2017, 17:05

En fait, après avoir traqué les mauvais noms de fichiers, ca marche! :)

Pour la suite des documents, j'ai créé une nouvelle trame qui intègre un tableur excel, afin de pouvoir reporter directement les chiffres de l'imc de personnes dans une courbe de suivi

du coups la macro actuelle ne marche pas puisqu'elle va chercher les données dans le tableau d'après.

Serait ce possible de faire le même principe de macro avec le fichier qui suit?
Sachant qu'il y a 2 tableaux avec 2 courbes de croissance: une pour les filles, une pour les garçons, et ce serait bien de prendre les chiffres dans le tableau non vide ^^
Le lien (fichier tros gros):
https://we.tl/MFQnkoBDcT
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 9 octobre 2017, 22:11

SalutBoltu,

Tu peux essayer ça en considérant que chaque fichier ne comporte que deux objets.
Sub ImportWord()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Chemin As String, Fichier As String
Dim NumDossier As String, ID As String
Dim i As Integer, j As Integer, p As Integer
Dim MonTab()

p = 0
Chemin = "P:\Donnees\Windows2012R2\Bureau\Travail sur IMC\"   'chemin où se trouve des fichiers
'----------------------------------------------------
'Boucle sur tous les fichiers doc du répertoire
'----------------------------------------------------
Fichier = Dir(Chemin & "*.docx") 'ou docx
Set WordApp = CreateObject("word.application")
WordApp.Visible = True    'Word reste affiché pendant l'opération /  Tu peux en mettant False masqué word pour + de rapidité
Do While Len(Fichier) > 0
    NumDossier = Left(Fichier, Len(Fichier) - 5) 'Nom du fichier sans l'extention
    NumDossier = Trim(Right(NumDossier, Len(NumDossier) - InStr(1, NumDossier, "N°") - 1))
    ID = Trim(Mid(Fichier, InStr(1, Fichier, "-") + 1, (Len(Fichier) - InStr(1, StrReverse(Fichier), "-")) - InStr(1, Fichier, "-")))
    Set WordDoc = WordApp.Documents.Open(Chemin & "\" & Fichier)
    p = p + 1
    Cells(p, 1).Value = "Dossier N°: " & NumDossier
    Cells(p, 2).Value = "Nom et Prénom : " & ID
    For i = 1 To 2
        LastLigne = 0
        WordDoc.InlineShapes(i).OLEFormat.Open
        If Range("B2").Value <> "" Then
            LastLigne = Range("B1").End(xlDown).Row
            MonTab = ActiveWorkbook.Sheets(1).Range("A1:I" & LastLigne).Value
            Exit For
        End If
    Next i
    WordDoc.Close (False)   'fermeture document Word
    If LastLigne <> 1 Then
        For i = 1 To UBound(MonTab, 1)
            For j = 1 To UBound(MonTab, 2)
                Sheets(1).Cells(p + i, j).Value = MonTab(i, j)
            Next j
        Next i
        p = p + i
    End If
    Fichier = Dir()   'récupére le nom du prochain fichier
Loop
WordApp.Quit    'fermeture session Word
       
End Sub
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 18 octobre 2017, 17:18

Merci pour ta réponse et pardon pour le retard de la mienne, j'avais pas mal de choses à boucler ces temps ci

Cela marche parfaitement bien, merci :)
Une petite demande en plus pour le nouveau type de fichier: serait ce possible de mettre le "Dossier N°: XX" sur une première colonne devant tous les autres, et de copier cette cellule devant chaque ligne de la personne concernée?

Cela permettrait de trier plus facilement les différents dossiers
(pour les fichiers ancienne version j'ai pu faire cela semi manuellement, donc ce serait juste bien pour les fichiers nouvelle version)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message