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 44 45 46 47 48 49
| '==================================================================================
'PROCÉDURE UTILISÉE POUR GÉNÉRER BORDEREAUX JUSTIFICATIFS
'==================================================================================
Sub GenerationBordereau_Cliquer()
'Déclaration des variables
Dim wApp As Word.Application
Dim oDoc As Word.Document
Dim NbLigne As Integer
Dim sTransport As String
Dim TotalTrans, TotalFrais, TotalHeb, TotalRes, SSTotalTrainAutre As Double
'Récupération du nombre de lignes et de colonnes
Dim xlWb As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim iR As Integer
'Affectation des données aux variables
Set wApp = New Word.Application
Set xlSh = ActiveWorkbook.ActiveSheet
'Récupération du nombre de lignes et de colonnes
NbLigne = Application.WorksheetFunction.CountA(Columns(1)) - 2 + 6
For iR = 7 To NbLigne
'Utilisation du fichier modèle suivant :
'Set oDoc = wApp.Documents.Add(ThisWorkbook.Path & "\" & "monCourrier.doc")
Set oDoc = wApp.Documents.Add("C:/RepModele/ModeleBordereau.doc")
'Affectation des données Excel aux signets
'Personne
oDoc.Bookmarks("Nom").Range.Text = ActiveWorkbook.ActiveSheet.Range("A" & iR)
oDoc.Bookmarks("Prenom").Range.Text = ActiveWorkbook.ActiveSheet.Range("B" & iR)
oDoc.Bookmarks("Service").Range.Text = ActiveWorkbook.ActiveSheet.Range("E" & iR)
'Mouvement
oDoc.Bookmarks("NatureDep").Range.Text = ActiveWorkbook.ActiveSheet.Range("J" & iR) & " - " & ActiveWorkbook.ActiveSheet.Range("K" & iR)
oDoc.Bookmarks("DateDep").Range.Text = ActiveWorkbook.ActiveSheet.Range("L" & iR)
'Svgd fichier
oDoc.SaveAs ("C:/MonRepTemp/" & Format(Date, "yyyy-mm-dd") & "_" & ActiveWorkbook.ActiveSheet.Range("A" & iR) & "_" & iR & ".doc")
oDoc.Close
Set oDoc = Nothing
Next iR
' Procedure permettant de concatener tous les fichiers word en 1
Call ConcatenerFichiersWrd
End Sub |
Partager