Importer des données de factures Word dans une feuille Excel
Bonsoir à tous.tes,
J'ai lu et regardé les vidéos sur la fonction VBA car je ne sais pas faire ce genre de programmation, et j'ai vu que d'autres utilisateurs ont crées des codes pour extraire des données de facture Word dans une bases de données sous Excel, c'est exactement ce que j'aimerai pouvoir faire.
J'ai besoin de votre aide car j'ai copier le code suivant sur le forum puisqu'il a l'air adapté à mon besoin mais je n'arrive pas à le faire exécuter, je précise que je travail sous mac.
Pourriez-vous m'aider à entrer les informations nécessaires à l'exécution de cette fonction, pour info je vous joins un exemple de facture et la feuille Excel.
J'espère que l'un de vous pourra m'aider et me faire gagner un temps précieux, d'avance merci.
Cordialement,
Christophe.
Sub Importation_Donnees_Word()
' -- Déclaration des variables
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
' -- Initialisation des variables
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) 'on sauvegarde dans la 1re feuille
sChemin = ChoisirRepertoire & "\" 'fonction pour choisir le répertoire contenant les fichier Word
'sChemin = ThisWorkbook.Path & "\" 'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier.
Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True 'ne pas afficher Word pendant l'exécution
i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 '1re ligne où on va écrire les données dans le fichier Excel
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
' Nom du fichier
ws.Cells(i, 1) = sNomFichier
' No de facture (par la fonction FIND)
WApp.Selection.HomeKey unit:=6 'Retourne au début du fichier Word
WApp.Selection.Find.ClearFormatting 'on "vide la mémoire" de la fonction Recherche
WApp.Selection.Find.Execute "N° Facture" 'On trouve le texte "No Facture"
WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2 'On se déplace de 3 mots
Set WSel = WApp.Selection 'sélection du texte trouvé
ws.Cells(i, 2) = Trim(Split(WSel, ":")(1)) 'Le No de facture est la 2e chaîne de caractères séparés par 2 ":"
' No Vendeur (dans le 2e tableau, ligne 2, colonne 1)
WDoc.Tables(2).Cell(2, 1).Range.Copy 'copie la valeur dans le presse papier
ws.Select 'bascule vers Excel
ws.Cells(i, 3).PasteSpecial (xlPasteValues) 'colle la valeur dana la cellule
' No du bon de commande (dans le 2e tableau, ligne 2, colonne 2)
WDoc.Tables(2).Cell(2, 2).Range.Copy
ws.Select
ws.Cells(i, 4).PasteSpecial (xlPasteValues)
' Nom du client (par la fonction FIND)
WApp.Selection.HomeKey unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "FACTURER À :"
WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
Set WSel = WApp.Selection
ws.Cells(i, 5) = Split(WSel, ":")(1)
' Montant total dû (dans le 3e tableau, ligne 10, colonne 2)
WDoc.Tables(3).Cell(10, 2).Range.Copy
ws.Select
ws.Cells(i, 6).PasteSpecial (xlPasteValues)
i = i + 1 'prochaine ligne
WDoc.Close False 'fermer le document Word sans enregistrer
sNomFichier = Dir 'prochain document
Loop
SortieNormale:
Application.ScreenUpdating = True
WApp.Quit 'Fermer l'instance de Word
Application.StatusBar = False 'Remise à zéro de la barre d'état
End Sub
La fonction qui suit permet de récupérer le chemin d’accès d’un répertoire choisi par l’utilisateur:
Function ChoisirRepertoire() As String
' -- Fonction permettant de choisir un répertoire
Dim oRepertoire As Object
ChoisirRepertoire = ""
Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
Set oRepertoire = Nothing
End Function
Bonjour et bienvenue,
Pour commencer et n'ayant pas de Mac, perso je ne vais pas pouvoir répondre.
Néanmoins, pour info :
- le code indiqué est adapté aux PC et ne pourra pas fonctionner avec un Mac en l'état (la gestion des répertoire étant différente)
- le doc word proposé n'est pas structuré idéalement pour pouvoir récupérer les info facilement. Si c'est possible il serait mieux de placer les différentes info dans des tableaux et éviter de mettre d'autres info sous forme d'image.
Est-ce que ce serait aidant si on propose une autre structure de doc?
Pierre
Bonjour Pierrep56,
Merci d'avoir pris le temps de me répondre.
C'est pour ça que je n'arrive pas à l'exécuter ... j'étais en train de me rendre fou avec les bibliothèques, les activeX et autres erreur.
En effet si vous avez une autre solution, j'ai essayé en convertissant le doc en txt ça fonctionne mais importe tous dans une même cellule et avec le séparateur ça met plusieurs lignes au lieu de colonne.
Ensuite j'aurai toujours besoin d'une macro car j'ai plus de 3500 factures à importer.
OK, donc pour les 3500 anciennes factures, je suis Mac-incompétent.
Sinon une bonne source pour excel sur Mac c'est Ron de Bruin (avec exemples de code, gestion des répertoires, ... et autres info) =>
Ah ok, merci quand même mais il ne me semble pas que les VBA Excel ne soit pas compatible avec Mac !