Discussion :

[Dermochelys]

Bonjour,

Tous les ans, notre QA manager nous demande de faire une synthèse du nombre d'activités que l'on a réalisé au cours de l'année précédente.

En pratique, tous nos activités sont facturées dans un document qui contient un tableau avec :
- dans la première colonne, la quantité (= nbr de fois ou l'activité à été réalisée)
- dans la deuxième colonne, l'intitulé de l'activité (= cet intitulé est assez constant dans sa formulation)
- dans la troisième colonne, le(s) prix unitaire(s) (= pour certaines activités, il peut y avoir plusieurs prix unitaires dégressifs suivant le nombre d'activités réalisées)
- dans la quatrième colonne, le total pour cette activité

Si ce genre de chose était écrit directement dans un fichier excel, ce serait facile de faire un tableau croisé dynamique pour en ressortir le nombre d'activité par intitulé.
MAIS chaque utilisateur encode lui-même sa facture dans un modèle .docx qu'il transforme en PDF ensuite, avant de l'envoyer. Dans ce document, la date d'émission de la facture est indiquée, bien sûr
Chaque utilisateurs stocke ses factures (docx et PDF) dans un sous-dossier de son dossier utilisateur.

La gymnastique annuelle consiste donc à parcourir manuellement tout ces sous-dossiers, pour rechercher les factures dont la date d’émission corresponds à l'année précédente, puis de noter pour chaque facture ce qui doit être comptabilisé.

Processus assez long et avec un risque d'oublier certaines factures...


Du coup, on m'a demandé s'il ne serait pas possible d'automatiser cela d'une manière ou d'une autre...


La première piste que je vois c'est de fournir une interface où les utilisateurs introduiront leurs données et une facture sera produite suivant le dernier modèle validé par QA. Je pense pouvoir faire ça. Mais c'est pour le futur (d'ici un an ou 2 en fonction de mes disponibilités).

D'ici là, peut-être serait-il possible d'automatiser le processus menant à la synthèse des informations demandées?
Mais je n'ai pas trop d'idée de comment m'y prendre pour coder tout ça dans Access (ou alors excel serait mieux?) (même si j'ai commencé à regarder s'il existait des exemples de codes qui me serait utiles)
Ce que je vois à faire, c'est :
- parcourir les différents dossiers
- rechercher les fichiers factures (sur base de leurs nom? de leur contenu?)
- lire le fichier pour ressortir, par ligne, le contenu de la première colonne et de la seconde, puis stocker cela dans une table. Sauf que le tableau contenant ces infos n'est pas le seul dans le modèle de docx (ils ont mis des tableaux partout pour formater les textes.... no comment)
et recommencer
puis finalement faire le total en fonction des intitulés de la seconde colonne


Si vous avez des suggestions pour optimiser le processus, je suis preneur

Belle journée à toutes et tous!

[EricDgn]

Bonjour,

Difficile de donner un avis sans avoir au moins quelques exemples de documents à exploiter. Travailler sur des pdf me semble plus compliqué que de travailler avec les documents Word. Si tous les utilisateurs utilisent vraiment le même modèle Word sans aller y modifier les tableaux et la façon d'indiquer les dates et numéros des factures cela devrait être "automatisable".

Sans doute commencer par une recherche sur internet du genre "vba grab data from word documents".
Un exemple de résultat: "extract-data-from-Word-to-Excel.

Cordialement.

[Dermochelys]

Bonjour EricDgn,

Je te remercie pour ton avis. Je serai plus à l'aise aussi avec des fichier word, je pense...
Je vais voir s'il est possible d'attacher ici un exemple du fichier modèle word.
De mon côté, je vais me plonger dans la recherche internet, comme tu le suggères. Et je reviendrai dès qu'il y a un peu de nouveau à partager.

Cordialement

[Dermochelys]

Bonjour EricDgn,

Bon ben... tu as mis dans le mille!
Le lien que tu suggérais était tout à fait adapté à mon besoin. Et en suivant la source d’inspiration du code présenté, puis en bidouillant un peu, j'arrive avec le code ci-dessous à choisir le dossier à exploité, et lire dans tous les fichiers Docx le tableau 2 (celui qui m'intéresse) pour finalement stocker dans une feuille excel l'ensemble des données des différentes fichiers/tableaux.

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
 
Option Explicit
Sub GetTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
 
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
Dim strFolder As String
Dim strFile As String
Dim WkBk As Workbook
Dim WkSht As Worksheet
Dim r As Long
 
Dim tableNo As Integer      'table number in Word
Dim iRow As Long            'row index in Excel
Dim iCol As Integer         'column index in Excel
Dim resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer
 
 
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
 
Set WkBk = ActiveWorkbook
'Disable any auto macros in the documents being processed
wdApp.WordBasic.DisableAutoMacros
 
strFile = Dir(strFolder & "\*.docx", vbNormal)
 
resultRow = 1       '4 avant
 
While strFile <> ""
    Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    'Set WkSht = WkBk.Sheets.Add
    'WkSht.Name = Split(strFile, ".docx")(0)
 
    With wdDoc
        tableNo = wdDoc.Tables.Count
        tableTot = wdDoc.Tables.Count
        If tableNo = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        'ElseIf tableNo > 1 Then
        '    tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
        '    "Enter the table to start from", "Import Word Table", "1")
        End If
        DoEvents
 
        For tableStart = 2 To tableTot
            With .Tables(tableStart)
                Cells(resultRow, 1) = strFile 'j'ai ajouté ceci
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Cells(resultRow + 2, iCol + 1) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
                    Next iCol
                    resultRow = resultRow + 1
                Next iRow
            End With
            resultRow = resultRow + 2
        Next tableStart
 
        .Close SaveChanges:=True
    End With
    strFile = Dir()
 
    resultRow = resultRow + 2
Wend
 
ErrExit:
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
'Set WkSht = Nothing
Set WkBk = Nothing
Application.ScreenUpdating = True
End Sub
 
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

J'ai quelques soucis de formatage (quand il y a plusieurs lignes dans la cellule du tableau word, faudrait que je remplace le saut de ligne par un ; ... et j'ai pas encore trouvé comment faire...), mais je devrai arriver à résoudre ça....

Un tout grand merci pour ton aide

[EricDgn]

Bonjour,

Une version modifiée du code, réglant le problème des sauts de ligne (lignes 58 à 62) et celui pouvant se produire lorsque l'on charge des tableaux Word dont certaines cellules sont fusionnées (lignes 54-55 et 65-66):

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
Option Explicit
 
'--- adapté de
'--- https://www.excelguru.ca/forums/showthread.php?8900-Help-with-VBA-to-extract-data-from-Word-to-Excel
'--- https://stackoverflow.com/questions/40932675/excel-vba-import-word-table-with-merged-cells-to-excel
 
Sub GetTableData()
    '===> réference Microsoft Word Object
    Application.ScreenUpdating = False
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim wdTbl As Word.Table
    Dim wdCell As Word.Cell
    Dim strFolder As String
    Dim strFile As String
    Dim WkBk As Workbook
    Dim WkSht As Worksheet
    Dim iRow As Long            'n° ligne dans tableau Word
    Dim iCol As Integer         'n° colonne dans tableau Word
    Dim tableNo As Integer      'n° tableau dans Word
    Dim tableTot As Integer     'nb tableaux dans Word
    Dim kRow As Long            'n° ligne dans Excel
    Dim s As String
 
    'strFolder = GetFolder
    'If strFolder = "" Then GoTo ErrExit
    strFolder = ThisWorkbook.Path                       '--- à adapter
 
    Set WkBk = ActiveWorkbook
    '--- annule le démarrage automatique des macros dans Word
    wdApp.WordBasic.DisableAutoMacros
    strFile = Dir(strFolder & "\*.docx", vbNormal)      '--- à adapter
    kRow = 1
 
    While strFile <> ""
        Debug.Print strFile;
        Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
        '--- ReadOnly:=True évite erreur si document ouvert ailleurs
        With wdDoc
            tableTot = wdDoc.Tables.Count
            If tableTot = 0 Then
                Debug.Print ": aucune table"
            Else
                Debug.Print ": " & tableTot & " tables"
                For tableNo = 1 To tableTot
                    With .Tables(tableNo)
                        Cells(kRow, 1) = strFile & " - Tableau " & tableNo & "/" & tableTot
                        '--- copier les cellules du tableau Word dans la feuille Excel
                        'For iRow = 1 To .Rows.Count
                            'For iCol = 1 To .Columns.Count
                            '--- plus simple mais provoque une erreur s'il y a des cellules fusionnées dans le tableau Word
                            '--- ==> parcourir les cellules du tableau Word une à une
                            '--- attention: la présentation Excel ne va pas respecter les fusions faites dans Word
                        Set wdCell = .Cell(1, 1)
                        Do
                            iRow = wdCell.RowIndex
                            iCol = wdCell.ColumnIndex
                            s = wdCell.Range.Text
                            s = Replace(s, Chr(11), "|")    '--- nouvelle ligne
                            s = Replace(s, Chr(13), "|")    '--- nouveau paragraphe
                            s = WorksheetFunction.Clean(s)  '--- supprime caractères non imprimables (dont Chr(7))
                            If Right(s, 1) = "|" Then s = Left(s, Len(s) - 1)
                            s = Replace(s, "|", vbCrLf)     '--- remet des sauts de ligne tels qu'admis dans Excel
                            Cells(kRow + iRow, iCol + 1) = s
                            Set wdCell = wdCell.Next        '--- cellule suivante
                        Loop Until wdCell Is Nothing
                    End With
                    kRow = kRow + iRow + 2
                Next tableNo
            End If
            .Close SaveChanges:=False
        End With
        strFile = Dir()     '--- fichier suivant dans le dossier (ne va pas dans les sous-dossiers)
    Wend
    '---
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set WkSht = Nothing
    Set WkBk = Nothing
    Application.ScreenUpdating = True
    Debug.Print "--- Terminé ---"
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

Bonne continuation.

[Dermochelys]

Bonjour EricDgn,

Un tout grand merci pour cette amélioration du code!! Mais le résultat dans excel n'est pas super formaté. Il y a toujours ce caractère ¶ qui traîne dans le résultat excel.

On part d'un tableau word qui a 4 colonnes (indiquées ici entre les []) :
[¶1¶¶3][Activités supplémentaires¶- préparation ¶- microscopie][¶99.904/échantillon¶¶54.74/échantillon][¶20.01¶¶1568.83]

Sais-tu comment remplacer ce caractère par un retour de chariot dans la cellule excel (le texte serait donc dans une cellule sur 2 lignes ou plus)?


Bonne continuation également et bientôt bon Weekend

Edit: j'ai essayé les caractères ascii CHR(20), CHR(63) et CHR(244) mais ca ne semble pas être équivalent à ¶
Finalement j'ai trouvé, il s'agissait du caractère CHR(182)! La présentation est très propre maintenant