Comment Extraire plusieurs Cellules Word

Fermé
JeremyP6†Messages postés 2 Date d'inscription mardi 26 février 2013 Statut Membre Dernière intervention 27 mars 2013 - 27 mars 2013 à 11:48
Saluut a tous

J'ai un dossier contenant plusieurs fichiers Word, le but est de pouvoir choisir un fichier dans le dossier pour extraire le contenu de quelques cellules bien précises d'un tableaux differents

le probleme je sais pas comment organiser l'extraction et surtout le collage dans un autre Fichier Word

Exemple : dans mon fichier ci joint au dessous je veux extraire le contenu des cellules de la colonne Nom qui sont :
"système d'exploitation"
"Base de données"
"WAS, Serveurs Web"
"Service d'infrastructure"
"Environnement de développement"
et "Autres"
Dans le tableau Produit logiciel
et le contenu de la colonne version pour chaque cellules extraite

Voici mon code il me copie des colonnes complétes d'un seul tableau

Sub Macro()
'Déclaration des variables
Dim oFso As FileSystemObject
Dim oFol As Folder
Dim oFil As File
Dim oDlg As FileDialog
Dim stFolder As String

'Deux document, un qui recevra le résultat et un dans lequel
'la recherche sera exécutée
'La liste des mots à trouver sera dans le doc cible sous
'la forme d'une table
Dim oDocSource As Document, oDocCible As Document, oDocTrv As Document
Dim oTbl1 As Table, oTbl2 As Table
Dim oRw As Row
Dim boofound As Boolean
'Affectation des variables
Set oFso = New FileSystemObject
Set oDlg = Application.FileDialog(msoFileDialogFolderPicker)
'Affichage de la boîte de dialogue
oDlg.Show

'Affectation du document contenant la liste
Set oDocSource = Documents.Open(FileName:="E:\DocTestCopy\DAT.doc")
'Affectation du document qui recevra le résultat de la recherche
Set oDocCible = Documents.Add
'Affectation de la table qui recevra les résultats
Set oTbl2 = oDocCible.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)

'Titres des colonnes de la table
With oTbl2.Rows(1)
.Cells(1).Range.Text = "Nom"
.Cells(2).Range.Text = "Version"
.Cells(3).Range.Text = "Info"

End With
'Affectation de la table qui contient les mots à rechercher.
Set oTbl1 = oDocSource.Tables(7)
'Affectation du répertoire
Set oFol = oFso.GetFolder(oDlg.SelectedItems(1))
For Each oFil In oFol.Files

'Test pour ne traiter que les documents et ignorer les autres fichiers
If Right(oFil.Name, 4) = "docm" Or Right(oFil.Name, 4) = "docx" Or Right(oFil.Name, 3) = "doc" Then

'ouverture des fichiers
Set oDocTrv = Documents.Open(oFil.Path)
'selection du fichier
oDocTrv.Select
'boucle sur la table contenant les mots
For Each oRw In oTbl1.Rows
'Pour chaque mot, retour au début du document
Selection.HomeKey unit:=wdStory

'boucle sur la recherche
Do
'Recherche
With Selection.Find
'Récupération du mot de la liste
.Text = (oRw.Cells(1).Range.Text)
.Text = (oRw.Cells(2).Range.Text)
.Text = (oRw.Cells(4).Range.Text)
.Execute

'Affectation du résultat de la recherche à une variable
boofound = .Found
End With
'si la recherche est fructueuse
'If boofound Then
'Debug.Print oFil.Path & " - " & (oRw.Cells(1).Range.Text) & " - " & Selection.Information(wdActiveEndPageNumber)
'Ajout d'une ligne à la table
oTbl2.Rows.Add

'Utilisation du range de la nouvelle ligne de la table
With oTbl2.Rows(oTbl2.Rows.Count)
'Remplissage de la table
.Cells(1).Range.Text = (oRw.Cells(1).Range.Text)
.Cells(2).Range.Text = (oRw.Cells(2).Range.Text)
.Cells(3).Range.Text = (oRw.Cells(4).Range.Text)
End With
'End If
'test de sortie de boucle
Loop While boofound
Next oRw

'Fermeture du document dans lequel nous effectuons la recherche
oDocTrv.Close
End If
Next oFil
Set oTbl1 = Nothing
Set oTbl2 = Nothing
'oDocSource.Close
Set oDocSource = Nothing
Set oDlg = Nothing
Set oFol = Nothing

Set oFso = Nothing
End Sub
'Function NetText(stTemp As String) As String
'Fonction de nettoyage
'Supprime les deux derniers caractères de la cellule
'NetText = Left(stTemp, Len(stTemp) - 2)
'End Function


Merci pour votre Aide