Discussion :

[celine2391]

Bonjour,
comme vous allez le voir je débute ...
Je suis en train de créer une macro dans EXCEL, qui va ouvrir un fichier PDF dans Word et copier les tableaux les uns après les autres dans l'onglet Excel, je pense ne pas être loin, mais je suis bloquée

Merci beaucoup pour votre aide

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
Sub copier_tableaux_word()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Integer

    Set WordApp = CreateObject("word.application")
    WordApp.Visible = False
    Set WordDoc = WordApp.Documents.Open("C:\Users\Desktop\Offre 0003977508 2Aff test.docx")    'ouvre le document Word
    
     i = 1
     Tableau = WordDoc.Tables
     Do While Tableau <> ""
     i = i + 1
     
            ActiveWorkbook.Sheets.Cells(1, 1) = Tableau 'il semblerait que l'erreur soit ici
        
    Tableau = WordDoc
    Loop
    WordDoc.Close
    WordApp.Quit

End Sub

[Invité]

Bonjour,

Je ne vois pas votre fichier Word en pièce jointe.

[celine2391]

Justement, ce n'est pas un fichier word à l'origine mais un fichier PDF, en passant via Word, je peux le modifier et faire un copier coller des tableaux

[Invité]

Avez-vous référencé une DLL particulière ? Si oui laquelle ?

[celine2391]

Si j'ai bien compris DLL = un chemin spécifique pour recherche le fichier ?
Non, elle sera variable malheureusement

[Invité]

C'est ce fichier que vous auriez dû mettre en ligne.

[Invité]

Vos tableaux ont des cellules fusionnées :

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
 
Sub copier_ligne_word3()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim I As Integer, DerniereLigne As Integer
Dim ShDoc  As Worksheet
 
 
    Set ShDoc = Sheets("Feuil1")
    With ShDoc
         DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    End With
 
    Set WordApp = CreateObject("word.application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Open("C:\Users\Desktop\Offre 0003977508 2Aff test.pdf")    'ouvre le document Word
 
    With WordDoc
        'Debug.Print .Tables.Count
        For I = 1 To .Tables.Count
            .Tables(I).Range.Copy
            With ShDoc
                 DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2
                 .Paste Destination:=.Cells(DerniereLigne, 1)
            End With
        Next I
 
    End With
 
    WordDoc.Close
    WordApp.Quit
 
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Set ShDoc = Nothing
 
 
End Sub

[celine2391]

Bonjour Eric,

Le code semble top, mais elle bloque dès qu'il y a des cellules fusionnées, j'ai 2 questions :
- savez-vous comment je peux contourner si la dernière ligne du tableau est fusionnée ? (fractionner me semble compliquer à définir, peut être devons nous enregistrer uniquement le n° de ligne?)
- pouvez-vous m'expliquer cette ligne de code :".Paste Destination:=.Cells(DerniereLigne, 1) "?
Merci

[Invité]

Le code semble top, mais elle bloque dès qu'il y a des cellules fusionnées

Je n'ai pas de blocage chez moi.

- savez-vous comment je peux contourner si la dernière ligne du tableau est fusionnée ? (fractionner me semble compliquer à définir, peut être devons nous enregistrer uniquement le n° de ligne?)

De quelle ligne s'agit-il ? Capture d'écran.

- pouvez-vous m'expliquer cette ligne de code :".Paste Destination:=.Cells(DerniereLigne, 1) "?

Si vous ne décalez pas, les tableaux vont se superposer dans l'onglet.

[celine2391]

C'est bon j'ai réessayé tout est ok ! au top merci Beaucoup Eric !
Très bonne journée à vous