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
|
Sub ImportWord()
Dim wb As Workbook 'classeur Excel dans lequel on importe les données
Dim ws As Worksheet 'onglet Excel dans lequel on importe les données
Dim sChemin As String 'répertoire contenant les fichiers Word
Dim sNomFichier As String 'nom du fichier Word
Dim WApp As Object, WDoc As Object, WSel As Object
Dim i As Integer, j As Integer
Dim WTable As Word.Table
Dim Rng As Word.Range
Dim WTables As Word.Tables, OS, WAS, SGBD
Dim ii As Integer 'ligne où écrire
Dim sTexte As String
Dim CtrI As Long
'------------------- Initialisation des variables------------------
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) 'On sauvegarde dans Elements d'obsolescence")
'Fonction pour choisir le répertoire contenant les fichier Word
sChemin = ChoisirRepertoire & "\"
'Pour ouvrir tous les fichiers .doc*. 1er fichier.
sNomFichier = Dir(sChemin & "*.doc*")
'Pour créer un objet Word
Set WApp = CreateObject("Word.Application")
WApp.Visible = False
Application.ScreenUpdating = False
'--------Boucle sur les fichiers-----------------------------
Do While Len(sNomFichier) > 0
Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'Ouvre le document Word
Application.StatusBar = "Écriture ligne " & i 'Message dans Excel pour voir la progression
Set Rng = WDoc.Range 'Plage de recherche
With Rng.Find
.ClearFormatting
.Text = "FICHE SYNTHETIQUE" ' Texte à rechercher (se trouvant avant la table)
.Execute
End With
If Rng.Find.Found Then
Rng.Select
Rng.MoveStart unit:=wdTable
Rng.Goto What:=wdGoToTable, Which:=wdGoToNext, Count:=1
'Selectionne le tableau trouvé pour extraire les données
Set WTable = Rng.Tables(1) 'Selectionne le tableau trouvé
'Extraction ICI |
Partager