Assembler des documents word crées avec une MACRO Excel OU Copier/coller

jabrane

XLDnaute Nouveau
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

Code:
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
 

Discussions similaires


Haut Bas