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 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
| Option Explicit
Public Const CheminFichiersWord As String = "G:\ABC\DEF\GHI\JKL\MNO\"
Public Const LigneDeTitre As Long = 3
Public Ligne As Long
Public I As Long
Public Reponse As Long
Public ColDateEtablissement As Long
Public ColType As Long
Public ColLocalisation As Long
Public ColAdresse As Long
Public ColCodePostal As Long
Public ColVille As Long
Public ColNom As Long
Public ColPrenom As Long
Public ColIdentificationSansCle As Long
Public ColCleIdentifiantAss As Long
Public ColCleIdentifiantPs As Long
Public ColTypeOpposition As Long
Public ColEtape As Long
Public ColReferenceTraitement As Long
Public ColTraitementPar As Long
Public ColTraitementNom As Long
Public ColImpression As Long
Public ShDonnees As Worksheet
Public Continuer As Boolean
Public wApp As Object
Public oDoc As Object
Public Completude As String
Public MessagePresenceColonnes As String
Sub LancerLEdition()
Reponse = MsgBox("Vous allez imprimer le courrier. Voulez-vous continuer ?", vbOKCancel + vbQuestion)
If Reponse = vbOK Then
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
With Sheets("Base")
Range("U2").Select
If ActiveCell = "JR" Then
Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Justif.doc")
EditionDocument "Justif"
End If
Range("U2").Select
If ActiveCell = "NO" Then
Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Refus.doc")
EditionDocument "Refus"
End If
Range("U2").Select
If ActiveCell = "OK" Then
'Set oDoc = wApp.Documents.Open(CheminFichiersWord & "Accord.doc")
Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Accord.doc")
EditionDocument "Accord"
End If
End With
oDoc.PrintOut
oDoc.Close SaveChanges:=True
wApp.Quit ' Fermeture de Word
Set oDoc = Nothing
Set wApp = Nothing
End If
End Sub
Sub EditionDocument(NomDuDocument As String)
'Affectation des données Excel aux signets
oDoc.Bookmarks("Prénom").Range.Text = Sheets("Base").Range("F" & Ligne)
oDoc.Bookmarks("Nom").Range.Text = Sheets("Base").Range("E" & Ligne)
oDoc.Bookmarks("Adresse").Range.Text = Sheets("Base").Range("G" & Ligne)
oDoc.Bookmarks("Complément").Range.Text = ShDonnees.Range("H" & Ligne)
oDoc.Bookmarks("CP").Range.Text = ShDonnees.Range("I" & Ligne)
oDoc.Bookmarks("Ville").Range.Text = ShDonnees.Range("J" & Ligne)
oDoc.Bookmarks("Traité_par").Range.Text = ShDonnees.Range("AB" & Ligne)
oDoc.Bookmarks("Type_oppo").Range.Text = ShDonnees.Range("R" & Ligne)
oDoc.Bookmarks("Prénom").Range.Text = ShDonnees.Range("L" & Ligne)
oDoc.Bookmarks("Nom").Range.Text = ShDonnees.Range("K" & Ligne)
oDoc.Bookmarks("Date_étab").Range.Text = ShDonnees.Range("A" & Ligne)
oDoc.Bookmarks("Interv").Range.Text = ShDonnees.Range("V" & Ligne)
oDoc.Bookmarks("Ref").Range.Text = ShDonnees.Range("B" & Ligne)
oDoc.Bookmarks("Complément2").Range.Text = ShDonnees.Range("I" & Ligne)
End Sub |
Partager