Bonjour, je suis nouveau sur ce forum qui d'ailleurs m'a beaucoup dans le passé (sans m’être inscrit) et je remercie la totalités des membres l'aide apporter sur les différents topic, aujourd'hui je me retrouve dans une galère à manipuler plusieurs fichiers excel word en même temps, étant totalement novice en programmation je me retrouve à passer des heures voir des jours ... Voici ce que je souhaite faire : • Récupérer dans la colonne A1 jusqu’à A30 les différents numéros d’articles qui se trouve dans le fichier DE • Pour ensuite les rechercher dans le fichier BD en reprenant la totalité du tableau qui se trouve dans le fichier BD pour ensuite les coller dans un fichier Word Je vous mets en PJ une image ainsi que le fichier DE et BD afin que vous ayez une idée plus claire, Mon objectif est de pouvoir automatiser cette manipulation au travers d'un code VBA, Pourriez vous m'aidez SVP, Pensez vous que cela est faisable ? En vous remerciant par avance...

VBA pour la lecture d'une colonne Excel ensuite recherche dans BD puis word

Le 23/10/2019 à 14:37

Bonjour, je suis nouveau sur ce forum qui d'ailleurs m'a beaucoup dans le passé (sans m’être inscrit) et je remercie la totalités des membres l'aide apporter sur les différents topic, aujourd'hui je me retrouve dans une galère à manipuler plusieurs fichiers excel word en même temps, étant totalement novice en programmation je me retrouve à passer des heures voir des jours ...

Voici ce que je souhaite faire :

• Récupérer dans la colonne A1 jusqu’à A30 les différents numéros d’articles qui se trouve dans le fichier DE
• Pour ensuite les rechercher dans le fichier BD en reprenant la totalité du tableau qui se trouve dans le fichier BD pour ensuite les coller dans un fichier Word

Je vous mets en PJ une image ainsi que le fichier DE et BD afin que vous ayez une idée plus claire,

Mon objectif est de pouvoir automatiser cette manipulation au travers d'un code VBA,

Pourriez vous m'aidez SVP, Pensez vous que cela est faisable ?

En vous remerciant par avance,

7bd.xlsx (9.34 Ko)

11de.xlsx (8.34 Ko)

Le 29/10/2019 à 14:38

Bonjour Nawaazs,

Une question : Les tableaux du classeur "BD" ont-ils tous les mêmes dimensions (6 lignes x 4 colonnes) ?

Le 29/10/2019 à 16:16

GVIALLES a écrit :
Bonjour Nawaazs,
Une question : Les tableaux du classeur "BD" ont-ils tous les mêmes dimensions (6 lignes x 4 colonnes) ?

Bonjour GVIALLES,

Je te remercie pour ce retour, en ce qui concerne les dimensions, les tableaux ont bien 4 colonnes mais les lignes sont différents en en fonction des prestations, tu peux en avoir 6 comme 12 voir plus,

En espérant avoir répondu à ton interrogations,

Le 29/10/2019 à 17:25

Nawaazs,

Du coup, comment peut-on déterminer la fin des tableaux ?

Peux-tu fournir un BD.xlsx plus proche de la réalité ?

Le 29/10/2019 à 18:46

GVIALLES a écrit :
Nawaazs,
Du coup, comment peut-on déterminer la fin des tableaux ?
Peux-tu fournir un BD.xlsx plus proche de la réalité ?

GVIALLES,

Je m'excuse, rectification, il y a bien 6 ligne et 4 colonnes,

Comme convenu ci joint un exemple rapprochant un peu de la réalité,

8bd-exemple-realite.xlsx (14.62 Ko)

Le 30/10/2019 à 00:28

Bonsoir Nawaazs,

Je te propose de modifier la feuille 'DE' de la façon suivante:

on transforme la liste des articles en un tableau nommé "TableauArticles"
on ajoute une cellule nommé "BD" dans la quelle on stocke le nom du classeur BD
on ajoute un bouton pour déclencher la création des documents WORD

On ajoute le code suivant :

Option Explicit
Sub createDocs()
    Const cNbLignes = 3
    Dim oAppWORD As Object
    Dim oWK As Workbook
    Dim oSheetArticles As Worksheet
    Dim oSheetBD As Worksheet
    Dim oOL As ListObject
    Dim oCell As Range, oCellDB As Range
    Dim oRangeFind As Range
    Dim oRangeBD As Range
    Dim oDoc As Word.Document

    Dim sDBFileName As String, sDocname As String
    Dim lFirstRow As Long, lLastRow As Long
    Dim sArticle As String
    Dim lCount As Long

    'On affecte la feuille contenant les articles
    Set oSheetArticles = ThisWorkbook.Worksheets(1)
    'On affecte la listobjet contenant les articles
    Set oOL = oSheetArticles.ListObjects("TableauArticles")

    'On constitue le nom du classeur BD
    sDBFileName = ThisWorkbook.Path & "\" & ThisWorkbook.Names("BD").RefersToRange.Value
    'On ouvre le classeur BD
    Set oWK = Application.Workbooks.Open(sDBFileName, , True)
    ActiveWindow.Visible = False
    'On affecte la feuille DB contenant les tableaux
    Set oSheetBD = oWK.Worksheets(1)
    'On affecte l'objet WORD
    Set oAppWORD = CreateObject("Word.Application")

    'On boucle sur la liste des articles
    For Each oCell In oOL.DataBodyRange.Columns(1).Cells
        sArticle = oCell.Value
        'Recherche de l'articles dans la BD
        With oSheetBD.UsedRange
            'Si l'article est dans le 1ère cellule
            If InStr(1, .Cells(1, 1), sArticle) > 0 Then
                lFirstRow = 1
            Else
            'Sinon utilisation de la méthode Find
                Set oRangeFind = .Find(sArticle, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart _
                                    , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
                If Not oRangeFind Is Nothing Then
                    'Si l'article est trouvé dans la BD
                    lFirstRow = oRangeFind.Row
                Else
                    'Sinon
                    lFirstRow = 0
                End If
            End If

            If lFirstRow > 0 Then
                'On recherche de la dernière ligne du bloc soit 3 fois la référence de l'article
                lLastRow = oSheetBD.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow + 1, 1), oSheetBD.Cells(lLastRow, 1))
                lCount = 0
                For Each oCellDB In oRangeBD.Cells
                    If Left(oCellDB.Value, Len(sArticle)) = sArticle Then
                        lCount = lCount + 1
                        'Si le  nombre limite d'occurences (3) est atteinte
                        If lCount = cNbLignes Then
                            lLastRow = oCellDB.Row
                            'Si la cellule est fusionnée, on inclut les lignes de la fusion
                            If oCellDB.MergeCells Then
                                lLastRow = lLastRow + oCellDB.MergeArea.Rows.Count - 1
                            End If
                            'On sort
                            Exit For
                        End If
                    End If
                Next
                'On affecte la plage à copier
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow, 1), oSheetBD.Cells(lLastRow, 4))
                'On copie la plage
                oRangeBD.Copy
                'On créé un nouveau document WORD
                Set oDoc = oAppWORD.Documents.Add
                'On y colle la plage EXCEL
                oDoc.Content.Paste
                'On affecte le bord gauche du tableau dans le document
                oDoc.Tables(1).Rows.SetLeftIndent LeftIndent:=-63.8, RulerStyle:=wdAdjustNone
                'On construit le nom du document WORD
                sDocname = ThisWorkbook.Path & "\" & "Doc_" & sArticle & ".docx"
                'On sauvegarde le document
                oDoc.SaveAs2 sDocname
                'On ferme le document
                oDoc.Close
                Set oDoc = Nothing
            End If
        End With
    Next
    MsgBox "Création des documents WORD terminée!", vbExclamation
    'On fait le ménage
    oWK.Close False
    oAppWORD.Quit

    Set oAppWORD = Nothing
    Set oDoc = Nothing
    Set oWK = Nothing
    Set oSheetBD = Nothing
    Set oOL = Nothing
    Set oCell = Nothing
End Sub

Pour la cohérence, j'ai dû apporter une modification au classeur "BD"

Je joins mon classeur de test et le classeur BD modifié.

12bd-exemple-realite.xlsx (14.89 Ko)

10de-gvs.xlsm (25.26 Ko)

Le 30/10/2019 à 14:38

GVIALLES a écrit :

Bonsoir Nawaazs,

Je te propose de modifier la feuille 'DE' de la façon suivante:

on transforme la liste des articles en un tableau nommé "TableauArticles"
on ajoute une cellule nommé "BD" dans la quelle on stocke le nom du classeur BD
on ajoute un bouton pour déclencher la création des documents WORD

On ajoute le code suivant :

Option Explicit
Sub createDocs()
    Const cNbLignes = 3
    Dim oAppWORD As Object
    Dim oWK As Workbook
    Dim oSheetArticles As Worksheet
    Dim oSheetBD As Worksheet
    Dim oOL As ListObject
    Dim oCell As Range, oCellDB As Range
    Dim oRangeFind As Range
    Dim oRangeBD As Range
    Dim oDoc As Word.Document

    Dim sDBFileName As String, sDocname As String
    Dim lFirstRow As Long, lLastRow As Long
    Dim sArticle As String
    Dim lCount As Long

    'On affecte la feuille contenant les articles
    Set oSheetArticles = ThisWorkbook.Worksheets(1)
    'On affecte la listobjet contenant les articles
    Set oOL = oSheetArticles.ListObjects("TableauArticles")

    'On constitue le nom du classeur BD
    sDBFileName = ThisWorkbook.Path & "\" & ThisWorkbook.Names("BD").RefersToRange.Value
    'On ouvre le classeur BD
    Set oWK = Application.Workbooks.Open(sDBFileName, , True)
    ActiveWindow.Visible = False
    'On affecte la feuille DB contenant les tableaux
    Set oSheetBD = oWK.Worksheets(1)
    'On affecte l'objet WORD
    Set oAppWORD = CreateObject("Word.Application")

    'On boucle sur la liste des articles
    For Each oCell In oOL.DataBodyRange.Columns(1).Cells
        sArticle = oCell.Value
        'Recherche de l'articles dans la BD
        With oSheetBD.UsedRange
            'Si l'article est dans le 1ère cellule
            If InStr(1, .Cells(1, 1), sArticle) > 0 Then
                lFirstRow = 1
            Else
            'Sinon utilisation de la méthode Find
                Set oRangeFind = .Find(sArticle, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart _
                                    , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
                If Not oRangeFind Is Nothing Then
                    'Si l'article est trouvé dans la BD
                    lFirstRow = oRangeFind.Row
                Else
                    'Sinon
                    lFirstRow = 0
                End If
            End If

            If lFirstRow > 0 Then
                'On recherche de la dernière ligne du bloc soit 3 fois la référence de l'article
                lLastRow = oSheetBD.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow + 1, 1), oSheetBD.Cells(lLastRow, 1))
                lCount = 0
                For Each oCellDB In oRangeBD.Cells
                    If Left(oCellDB.Value, Len(sArticle)) = sArticle Then
                        lCount = lCount + 1
                        'Si le  nombre limite d'occurences (3) est atteinte
                        If lCount = cNbLignes Then
                            lLastRow = oCellDB.Row
                            'Si la cellule est fusionnée, on inclut les lignes de la fusion
                            If oCellDB.MergeCells Then
                                lLastRow = lLastRow + oCellDB.MergeArea.Rows.Count - 1
                            End If
                            'On sort
                            Exit For
                        End If
                    End If
                Next
                'On affecte la plage à copier
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow, 1), oSheetBD.Cells(lLastRow, 4))
                'On copie la plage
                oRangeBD.Copy
                'On créé un nouveau document WORD
                Set oDoc = oAppWORD.Documents.Add
                'On y colle la plage EXCEL
                oDoc.Content.Paste
                'On affecte le bord gauche du tableau dans le document
                oDoc.Tables(1).Rows.SetLeftIndent LeftIndent:=-63.8, RulerStyle:=wdAdjustNone
                'On construit le nom du document WORD
                sDocname = ThisWorkbook.Path & "\" & "Doc_" & sArticle & ".docx"
                'On sauvegarde le document
                oDoc.SaveAs2 sDocname
                'On ferme le document
                oDoc.Close
                Set oDoc = Nothing
            End If
        End With
    Next
    MsgBox "Création des documents WORD terminée!", vbExclamation
    'On fait le ménage
    oWK.Close False
    oAppWORD.Quit

    Set oAppWORD = Nothing
    Set oDoc = Nothing
    Set oWK = Nothing
    Set oSheetBD = Nothing
    Set oOL = Nothing
    Set oCell = Nothing
End Sub

Pour la cohérence, j'ai dû apporter une modification au classeur "BD"

Je joins mon classeur de test et le classeur BD modifié.

Bonjour GVIALLES,

Je te remercie pour ce ton travail, je test le code et je te fais un retour,

Encore une fois Merci beaucoup

Pour le moment je laisse ouvert le sujet, si au cas ou .... mais en tout cas merci beaucoup

Le 29/11/2019 à 16:15

Bonjour GVIALLES,

Je me permets de revenir vers toi, ayant essayer le code cela m'affiche un message d'erreur qui est :

Erreur d'exécution 9 :

L'indice ne n'appartient pas à la selection,

En attendant ton retour,

GVIALLES a écrit :

Bonsoir Nawaazs,

Je te propose de modifier la feuille 'DE' de la façon suivante:

on transforme la liste des articles en un tableau nommé "TableauArticles"
on ajoute une cellule nommé "BD" dans la quelle on stocke le nom du classeur BD
on ajoute un bouton pour déclencher la création des documents WORD

On ajoute le code suivant :

Option Explicit
Sub createDocs()
    Const cNbLignes = 3
    Dim oAppWORD As Object
    Dim oWK As Workbook
    Dim oSheetArticles As Worksheet
    Dim oSheetBD As Worksheet
    Dim oOL As ListObject
    Dim oCell As Range, oCellDB As Range
    Dim oRangeFind As Range
    Dim oRangeBD As Range
    Dim oDoc As Word.Document

    Dim sDBFileName As String, sDocname As String
    Dim lFirstRow As Long, lLastRow As Long
    Dim sArticle As String
    Dim lCount As Long

    'On affecte la feuille contenant les articles
    Set oSheetArticles = ThisWorkbook.Worksheets(1)
    'On affecte la listobjet contenant les articles
    Set oOL = oSheetArticles.ListObjects("TableauArticles")

    'On constitue le nom du classeur BD
    sDBFileName = ThisWorkbook.Path & "\" & ThisWorkbook.Names("BD").RefersToRange.Value
    'On ouvre le classeur BD
    Set oWK = Application.Workbooks.Open(sDBFileName, , True)
    ActiveWindow.Visible = False
    'On affecte la feuille DB contenant les tableaux
    Set oSheetBD = oWK.Worksheets(1)
    'On affecte l'objet WORD
    Set oAppWORD = CreateObject("Word.Application")

    'On boucle sur la liste des articles
    For Each oCell In oOL.DataBodyRange.Columns(1).Cells
        sArticle = oCell.Value
        'Recherche de l'articles dans la BD
        With oSheetBD.UsedRange
            'Si l'article est dans le 1ère cellule
            If InStr(1, .Cells(1, 1), sArticle) > 0 Then
                lFirstRow = 1
            Else
            'Sinon utilisation de la méthode Find
                Set oRangeFind = .Find(sArticle, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart _
                                    , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
                If Not oRangeFind Is Nothing Then
                    'Si l'article est trouvé dans la BD
                    lFirstRow = oRangeFind.Row
                Else
                    'Sinon
                    lFirstRow = 0
                End If
            End If

            If lFirstRow > 0 Then
                'On recherche de la dernière ligne du bloc soit 3 fois la référence de l'article
                lLastRow = oSheetBD.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow + 1, 1), oSheetBD.Cells(lLastRow, 1))
                lCount = 0
                For Each oCellDB In oRangeBD.Cells
                    If Left(oCellDB.Value, Len(sArticle)) = sArticle Then
                        lCount = lCount + 1
                        'Si le  nombre limite d'occurences (3) est atteinte
                        If lCount = cNbLignes Then
                            lLastRow = oCellDB.Row
                            'Si la cellule est fusionnée, on inclut les lignes de la fusion
                            If oCellDB.MergeCells Then
                                lLastRow = lLastRow + oCellDB.MergeArea.Rows.Count - 1
                            End If
                            'On sort
                            Exit For
                        End If
                    End If
                Next
                'On affecte la plage à copier
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow, 1), oSheetBD.Cells(lLastRow, 4))
                'On copie la plage
                oRangeBD.Copy
                'On créé un nouveau document WORD
                Set oDoc = oAppWORD.Documents.Add
                'On y colle la plage EXCEL
                oDoc.Content.Paste
                'On affecte le bord gauche du tableau dans le document
                oDoc.Tables(1).Rows.SetLeftIndent LeftIndent:=-63.8, RulerStyle:=wdAdjustNone
                'On construit le nom du document WORD
                sDocname = ThisWorkbook.Path & "\" & "Doc_" & sArticle & ".docx"
                'On sauvegarde le document
                oDoc.SaveAs2 sDocname
                'On ferme le document
                oDoc.Close
                Set oDoc = Nothing
            End If
        End With
    Next
    MsgBox "Création des documents WORD terminée!", vbExclamation
    'On fait le ménage
    oWK.Close False
    oAppWORD.Quit

    Set oAppWORD = Nothing
    Set oDoc = Nothing
    Set oWK = Nothing
    Set oSheetBD = Nothing
    Set oOL = Nothing
    Set oCell = Nothing
End Sub

Pour la cohérence, j'ai dû apporter une modification au classeur "BD"

Je joins mon classeur de test et le classeur BD modifié.

Le 29/11/2019 à 16:20

Re Bonjour GVIALLES,

Ne prend pas en compte mon dernier message, effectivement le code fonctionne parfaitement,

Une petite erreur de Copier/coller de ma part,

Désolé,

Nawaazs a écrit :

Bonjour GVIALLES,

Je me permets de revenir vers toi, ayant essayer le code cela m'affiche un message d'erreur qui est :

Erreur d'exécution 9 :

L'indice ne n'appartient pas à la selection,

En attendant ton retour,

GVIALLES a écrit :

Bonsoir Nawaazs,

Je te propose de modifier la feuille 'DE' de la façon suivante:

on transforme la liste des articles en un tableau nommé "TableauArticles"
on ajoute une cellule nommé "BD" dans la quelle on stocke le nom du classeur BD
on ajoute un bouton pour déclencher la création des documents WORD

On ajoute le code suivant :

Option Explicit
Sub createDocs()
    Const cNbLignes = 3
    Dim oAppWORD As Object
    Dim oWK As Workbook
    Dim oSheetArticles As Worksheet
    Dim oSheetBD As Worksheet
    Dim oOL As ListObject
    Dim oCell As Range, oCellDB As Range
    Dim oRangeFind As Range
    Dim oRangeBD As Range
    Dim oDoc As Word.Document

    Dim sDBFileName As String, sDocname As String
    Dim lFirstRow As Long, lLastRow As Long
    Dim sArticle As String
    Dim lCount As Long

    'On affecte la feuille contenant les articles
    Set oSheetArticles = ThisWorkbook.Worksheets(1)
    'On affecte la listobjet contenant les articles
    Set oOL = oSheetArticles.ListObjects("TableauArticles")

    'On constitue le nom du classeur BD
    sDBFileName = ThisWorkbook.Path & "\" & ThisWorkbook.Names("BD").RefersToRange.Value
    'On ouvre le classeur BD
    Set oWK = Application.Workbooks.Open(sDBFileName, , True)
    ActiveWindow.Visible = False
    'On affecte la feuille DB contenant les tableaux
    Set oSheetBD = oWK.Worksheets(1)
    'On affecte l'objet WORD
    Set oAppWORD = CreateObject("Word.Application")

    'On boucle sur la liste des articles
    For Each oCell In oOL.DataBodyRange.Columns(1).Cells
        sArticle = oCell.Value
        'Recherche de l'articles dans la BD
        With oSheetBD.UsedRange
            'Si l'article est dans le 1ère cellule
            If InStr(1, .Cells(1, 1), sArticle) > 0 Then
                lFirstRow = 1
            Else
            'Sinon utilisation de la méthode Find
                Set oRangeFind = .Find(sArticle, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart _
                                    , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
                If Not oRangeFind Is Nothing Then
                    'Si l'article est trouvé dans la BD
                    lFirstRow = oRangeFind.Row
                Else
                    'Sinon
                    lFirstRow = 0
                End If
            End If

            If lFirstRow > 0 Then
                'On recherche de la dernière ligne du bloc soit 3 fois la référence de l'article
                lLastRow = oSheetBD.UsedRange.SpecialCells(xlCellTypeLastCell).Row
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow + 1, 1), oSheetBD.Cells(lLastRow, 1))
                lCount = 0
                For Each oCellDB In oRangeBD.Cells
                    If Left(oCellDB.Value, Len(sArticle)) = sArticle Then
                        lCount = lCount + 1
                        'Si le  nombre limite d'occurences (3) est atteinte
                        If lCount = cNbLignes Then
                            lLastRow = oCellDB.Row
                            'Si la cellule est fusionnée, on inclut les lignes de la fusion
                            If oCellDB.MergeCells Then
                                lLastRow = lLastRow + oCellDB.MergeArea.Rows.Count - 1
                            End If
                            'On sort
                            Exit For
                        End If
                    End If
                Next
                'On affecte la plage à copier
                Set oRangeBD = oSheetBD.Range(oSheetBD.Cells(lFirstRow, 1), oSheetBD.Cells(lLastRow, 4))
                'On copie la plage
                oRangeBD.Copy
                'On créé un nouveau document WORD
                Set oDoc = oAppWORD.Documents.Add
                'On y colle la plage EXCEL
                oDoc.Content.Paste
                'On affecte le bord gauche du tableau dans le document
                oDoc.Tables(1).Rows.SetLeftIndent LeftIndent:=-63.8, RulerStyle:=wdAdjustNone
                'On construit le nom du document WORD
                sDocname = ThisWorkbook.Path & "\" & "Doc_" & sArticle & ".docx"
                'On sauvegarde le document
                oDoc.SaveAs2 sDocname
                'On ferme le document
                oDoc.Close
                Set oDoc = Nothing
            End If
        End With
    Next
    MsgBox "Création des documents WORD terminée!", vbExclamation
    'On fait le ménage
    oWK.Close False
    oAppWORD.Quit

    Set oAppWORD = Nothing
    Set oDoc = Nothing
    Set oWK = Nothing
    Set oSheetBD = Nothing
    Set oOL = Nothing
    Set oCell = Nothing
End Sub

Pour la cohérence, j'ai dû apporter une modification au classeur "BD"

Je joins mon classeur de test et le classeur BD modifié.

Rechercher des sujets similaires à "vba lecture colonne ensuite recherche puis word"