Ajouter Bouton "envoyer à" à un nouveau doc Word créé
Bonjour,
Difficile de trouver un sujet sommaire pour mon problème.
J'ai déjà une formule VBA qui crée un fichier Word contenant le contenu d'une feuille Excel. J'aimerais savoir s'il est possible d'intégrer un bouton à ce nouveau document Word qui permettrait à l'utilisateur d'envoyer ce fichier Word par courriel.
Comme alternative, j'avais utilisé une commande qui créait et envoyait un fichier PDF directement de ma page Excel mais la problématique est que le client ne pouvait modifié les données de la feuille Excel avant de l'envoyer en PDF car il y a une formule à l'intérieur des cellules (qui fournit le texte d'une autre page si la cellule a été cochée.)
Donc, s'il serait possible d'intégrer le bouton ActiveX, qui enverrait le nouveau document Word créé à une adresse courriel, à la formule ci-jointe, ça serait super.
Sub CopyXLStoDOC()
'declare local variables and constants
Dim oDoc As Word.Document
Dim oWord As Word.Application
Dim rRange1 As Range, rRange2 As Range
Const sDocPath As String = "C:\Document2.docx"
'set ranges to copy
Set rRange1 = Worksheets("SoMC - ECM").Range("EngSoMC")
Set rRange2 = Worksheets("SoMC - ECM").Range("FrSoMC")
'open the Word document, if it doesn't exist, then create one
On Error Resume Next
Set oDoc = GetObject(sDocPath)
Set oWord = oDoc.Parent
If Err <> 0 Then
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add
End If
oWord.Visible = True
'copy and paste first range into Word
rRange1.Copy
oDoc.ActiveWindow.Selection.PasteSpecial DataType:=wdPasteRTF
'format table
oDoc.ActiveWindow.Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
oDoc.ActiveWindow.Selection.Tables(1).Style = "Table Grid"
'copy and paste second range into Word after pagebreak
rRange2.Copy
'remove the next line if you want to paste rRange2 directly after rRange1
oDoc.ActiveWindow.Selection.InsertBreak Type:=wdPageBreak
oDoc.ActiveWindow.Selection.PasteSpecial DataType:=wdPasteRTF
'move the selection back two pages
oDoc.ActiveWindow.Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious, Count:=1
'oDoc.ActiveWindow.Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=2, Name:=""
'format table
oDoc.ActiveWindow.Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
oDoc.ActiveWindow.Selection.Tables(1).Style = "Table Grid"
'Clean up objects
Set oDoc = Nothing
Set rRange1 = Nothing
Set rRange2 = Nothing
End Sub
MERCI BEAUCOUP!!
Précision, dans Word, le code suivant me permet d'envoyer le document Word par courriel. Mais j'aimerais être entre mesure d'intégrer le code dans Excel pour qu'il soit présent dans le Word crée par Excel, contenant les données Excel que l'on veut.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "TEST"
.Body = "For your consideration. Thank you."
.To = "TEST@TEST.COM"
.Importance = olImportanceNormal 'Or olImportanceNormal
.Attachments.Add ActiveSheet.Copy
.Send
End With
MsgBox "E-mail successfully sent", 64
Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub
Toujours pas de réponses, dommage.