1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
| Sub CorpsMail()
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
FichierAttente = Application.Index(Para.Range("E:E"), Application.Match(Environ("COMPUTERNAME"), Para.Range("D:D"), 0)) & Para.Range("B5").Value & "1-" & NomDoc
Set WordDoc = WordApp.Documents.Open(Application.Index(Para.Range("E:E"), Application.Match(Environ("COMPUTERNAME"), Para.Range("D:D"), 0)) & Para.Range("B5").Value & NomDoc)
WordApp.Activedocument.SaveAs Filename:=FichierAttente
LigneDoc = Application.Match(NomDoc, FeSignet.Range("A:A"), 0)
Set TextMail = WordApp.Activedocument
For Col = 7 To 200 Step 2
If FeSignet.Cells(LigneDoc, Col) = "" Then Exit For
MonText = Mafeuil.Range(FeSignet.Cells(LigneDoc, Col).Value).Value
MonSignet = FeSignet.Cells(LigneDoc, Col + 1).Value
Place = TextMail.Bookmarks(MonSignet).Range.Start
TextMail.Bookmarks(MonSignet).Range.Text = MonText
TextMail.Bookmarks.Add Name:=MonSignet, Range:=TextMail.Range(Place, Place + Len(MonText))
Next Col
MonSignet = "Lien"
Place = TextMail.Bookmarks(MonSignet).Range.Start
TextMail.Hyperlinks.Add Anchor:=TextMail.Selection.Range, _
Address:="https://www.google.fr/", SubAddress:="", ScreenTip:="", TextToDisplay:="Formulaire de contact"
End Sub |
Partager