Assembler plusieurs fichiers word dans un seul document via macro excel

Signaler
-
 Gabrieljb -
Bonjour,
je v'ai vous expliquer par detail ce que ma macro doit faire:
Pour n importe quel fichier excel ouvert , ma macro se declanche automatiquement, celon des condition sur le nom du fichier ( si le nom du fichier = Class*.xls), traite le document, parcour la feuille ligne par ligne et pour chaque ligne : la macro copie les données dans un nouveau documen WORD( un model Word dont les données doivent etre enregistrés) , enregistre le nouveau document word , puis l envoi par mail pour une destination marqué dans une cellule precise du fichier excel .

Le declanchement du macro se fait pour chaque fichier excel ouvert , meme si plusieurs fichiers sont ouvert , la macro les traite un par un .
Mais le probleme reste , comment ouvrir ces fichiers la automatiquement?? ces fichiers sont enregistré sur un serveur d application et tout le traitement va etre réalisé sur ce serveur.Chaque 20 mn on obtient dans la meme repertoires des nouveaux fichiers excel que je veut les traitées tous par ma macro .Est ce que j'ai bien expliquer l utilité de ma macro ?? Merci
Sub MacroAutoJB()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim oWdApp As Object

Dim i As Byte
Dim sChemin As String
Dim wb As Workbook

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

On Error Resume Next
Dim nom As String
Dim sName As String
Dim sPath As String

On Error Resume Next
Dim j As Integer
j = ActiveSheet.UsedRange.Rows.Count 
Dim n As Byte
n = Cells(1, Columns.Count).End(xlToLeft).Column

If ActiveWorkbook.Name Like "WClass*.xls" Then

user = Environ("username")
sName = ActiveWorkbook.Name
sPath = "C:\Documents and Settings" & user & "\My Documents"
sName = Replace(sName, ".xls", "_Word")
MkDir sName
For j = 2 To j 

Set WordApp = CreateObject("word.application") 'ouvre session word
nom = Sheets(1).Cells(j, 2)
mail = Sheets(1).Cells(2, n)

Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings" & user & "\ClassJb.doc")
Set oWdApp = CreateObject("Word.Application")
Set WordDoc = oWdApp.Documents.Open("C:\Documents and Settings" & user & "\ClassJb.doc")

For i = 1 To n - 1
'les signets du document Word sont nommés Sig1 , Sig2 , Sig3
WordDoc.Bookmarks("Sig" & i).Range.Text = Cells(j, i) ' enregistre la ligne selectionné
Next i

WordDoc.Bookmarks("Signet").Range.Text = Cells(j, 2)
WordDoc.Bookmarks("Sigmail").Range.Text = Cells(j, n)

WordDoc.SaveAs Filename:=sPath & sName & "" & nom & ".doc"
WordApp.Visible = False 

oWdApp.Quit
ActiveDocument.Close True
WordApp.Quit 
Next j
ActiveWorkbook.Close

End Sub

2 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
Salut

Code sans indentation (espaces en tête de ligne) : difficile à relire, surtout quand il y a des boucles For-Next.

Perso, j'utilise plutôt une sardine qu'un macro; moins gros.
Je plaisante : unE macro

Pour lister les fichiers d'un répertoire : Dir, exemple :
    Dim myFolder As String
    Dim myFile   As String
    myFolder = "C:\*.xls"
    myFile = Dir(myFolder)   ' Premier fichier dispo
    Do While myFile <> ""
        MsgBox myFolder & "" & myFile
        DoEvents
        myFile = Dir    ' Fichier Suivant
    Loop

A toi d'imaginer comment intégrer cela à ton code existant, avec tes poissons.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Merci pour votre repense ,
Ma macro permet de créer , à chaque ligne du fichier excel un nouveau document word , alors que je voudarais avoir un seul document word crée puis ajouter les autres données des lignes dans ce document word , pas d autre document ..Merci de m avoir aidez.