1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| Dim TimeToRun
Sub Auto_Open()
Call scheduleJb
End Sub
Sub scheduleJb()
TimeToRun = Now + TimeValue("00:00:01")
Application.OnTime TimeToRun, "MacroAutoJB"
End Sub
Sub MacroAutoJB()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim oWdApp As Object 'Lancer Word
Dim i As Byte
Dim sChemin As String
On Error Resume Next
Dim nom 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 "Class*.xls" Then ' Condition selon les noms des fichiers excel
Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\User\My Documents\Class_fich.doc") 'ouvre document Word
Set oWdApp = CreateObject("Word.Application")
Set WordDoc = oWdApp.Documents.Open("C:\Documents and Settings\User\My Documents\Class_fich.doc")
For i = 1 To n
WordDoc.Bookmarks("Sig" & i).Range.Text = Cells(j, i)
Next i
WordDoc.Bookmarks("Signet").Range.Text = Cells(j, 2) 'l entete du fichier WORD ou le nom du formulaire est attribuée a "Signet"
WordDoc.SaveAs Filename:=nom & ".doc"
' enregistre le nouveau doc word selon le nom de la 2 eme colonne du fichier excel
WordApp.Visible = False
End If
Next j |
Partager