XL 2021 Etat de sortie sur Word a partir d'une base Excel

cherco

XLDnaute Nouveau
Bonjour a tous,

voila, j'ai une base de données des employés sous Excel 2021 et j'aimerais obtenir un document word qui m'affiche la liste des employés selon la fac ou ils travails

cette fois je me suis cassé la tête et donc j'ai pondu le code suivant qui fait le gros du travail.

seul souci est il m'affiche qu'un seul employé au lieu de 10. je n'arrive pas savoir où mettre la boucle pour qu'il m'affiche les 10 employés a la suite

voila le code:

Sub sendWord()

Dim wd As Word.Application
Dim wddoc As Word.Document
Set wd = New Word.Application ' création du document word

Dim FrRow, LastRow As Long
LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row

For FrRow = 3 To LastRow
Set wddoc = wd.Documents.Open(ThisWorkbook.Path & "\borderauxfac.docx")
wd.Visible = False

' Transfere de données
wd.Selection.GoTo what:=wdGoToBookmark, Name:="StructureName" ' (doyen, recteur,...)
wd.Selection.TypeText Text:=Feuil1.Cells(FrRow, "N")
wd.Selection.GoTo what:=wdGoToBookmark, Name:="Faculte" ' nom de la faculté
wd.Selection.TypeText Text:=Feuil1.Cells(FrRow, "O")
wd.Selection.GoTo what:=wdGoToBookmark, Name:="NomATS" ' nom des employés
wd.Selection.TypeText Text:=Feuil1.Cells(FrRow, "B")

' Effacer les Signets en cas d'erreur
On Error Resume Next
wddoc.Bookmarks("StructureName").Delete
wddoc.Bookmarks("Faculte").Delete

'sauvegarde du document
wddoc.SaveAs2 ThisWorkbook.Path & "\" & Feuil1.Cells(FrRow, "O").Value & ".docx"
wddoc.Close
Set wddoc = Nothing

Next FrRow

MsgBox "Vos fichiers ont été Sauvegardés avec succès", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "Confirmation"

End Sub


voici un exemple de résultat bien sur simplifier avec le problème :

sans titre
 
Dernière édition:

cherco

XLDnaute Nouveau
oooh oui pardons j'ai oublié d'enlever le 7 voila :

LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row

je l'ai modifié sur le 1er message.

j'ai joint deux fichiers test (excel et word) ou j'ai rajouter un bouton " send to word" un peu grossier désolé pour ca.
 

Pièces jointes

  • Test.xlsm
    35.1 KB · Affichages: 10
  • borderauxfac.docx
    17.8 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonjour cherco, le forum,

Vous pouvez utiliser cette macro :
VB:
Sub sendWord()
Dim wd As Word.Application
Dim wddoc As Word.Document, FrRow As Long, LastRow As Long, fac As String, liste As String, i As Long
Set wd = New Word.Application  ' création du document word

LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row

For FrRow = 3 To LastRow
    Set wddoc = wd.Documents.Open(ThisWorkbook.Path & "\borderauxfac.docx")
    wd.Visible = False
   
'création de la liste
    fac = Trim(Feuil1.Cells(FrRow, "O")) 'Trim efface les espaces superflus...
    liste = ""
    For i = 3 To LastRow
        If Trim(Feuil1.Cells(i, "O")) = fac Then liste = liste & vbLf & Feuil1.Cells(i, "B") 'concaténation
    Next i

'transfere de données
    wddoc.Bookmarks("StructureName").Range = Feuil1.Cells(FrRow, "N")
    wddoc.Bookmarks("Faculte").Range = Feuil1.Cells(FrRow, "O")
    wddoc.Bookmarks("NomATS").Range = Mid(liste, 2)
   
'sauvegarde du document
    wddoc.SaveAs2 ThisWorkbook.Path & "\" & fac & ".docx"
    wddoc.Close
Next FrRow

Set wd = Nothing
MsgBox "Vos fichiers ont été Sauvegardés avec succès", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "Confirmation"

End Sub
Une remarque encore : pour une même valeur en colonne "O" il peut y avoir des noms différents en colonne "N", c'est le dernier nom trouvé qui est retenu dans le fichier Word créé.

A+
 

Pièces jointes

  • Test.xlsm
    32.5 KB · Affichages: 7
  • borderauxfac.docx
    18.1 KB · Affichages: 7

cherco

XLDnaute Nouveau
Bonsoir job75, merci pour votre aide.
ca marche très bien le code est moins encombré et plus simple je trouve.
j'arrive a comprendre alors que je débute, ca donne envie d'apprendre merci encore.

La colonne N est conditionnée par la colonne O, puis que pour le même service ou fac, on a tjrs le même poste a savoir "doyen", "responsable",...etc; donc ce n'est pas un problème.
 

Statistiques des forums

Discussions
313 283
Messages
2 096 810
Membres
106 751
dernier inscrit
Souleymani