Envoi d'une page par courriel

Salut,

J'aimerais avoir une option pour envoyer une page de mon classeur par email.

Pour ça, je voudrais avoir une case dans laquelle j'entre l'adresse email du destinataire, un bouton "envoi" et j'aimerais que le sujet du courriel soit le contenu d'une autre case.

Aussi, ultimement, j'aimerais que le destinataire ne puisse pas modifier le contenu. Comme si c'était un screenshot ou mieux, un PDF. Mais j'imagine que ca ca devient compliqué.

J'ai trouvé cette base, mais je n'arrive pas à l'adapter:

Sub EnvoiMail()
Workbooks("UnClasseur").SendMail Recipients:="tartem.pion@mimi.com", _
Subject:="Test envoi classeur", _
ReturnReceipt:=True
End Sub

Pouvez-vous m'aider svp ?

Merci,

balty

Bon ben je viens de trouver un code sur le net:

Ça envoie par email la page courante en attachement à la personne dont l'email est écrit dans une case (AO12 dans mon cas):

Sub Mail_Every_Worksheet()

'Working in 2000-2007

Dim sh As Worksheet

Dim wb As Workbook

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then

'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143

Else

'You use Excel 2007

FileExtStr = ".xlsm": FileFormatNum = 52

End If

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

Set OutApp = CreateObject("Outlook.Application")

OutApp.Session.Logon

For Each sh In ThisWorkbook.Worksheets

If sh.Range("AO12").Value Like "?*@?*.?*" Then

sh.Copy

Set wb = ActiveWorkbook

TempFileName = "Sheet " & sh.Name & " of " _

& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Set OutMail = OutApp.CreateItem(0)

With wb

.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

On Error Resume Next

With OutMail

.To = sh.Range("AO12").Value

.CC = ""

.BCC = ""

.Subject = "This is the Subject line"

.Body = "Please, find attached our latest quotation for your project"

.Attachments.Add wb.FullName

'You can add other files also like this

'.Attachments.Add ("C:\test.txt")

.Display 'or use .Display

End With

On Error GoTo 0

.Close SaveChanges:=False

End With

Set OutMail = Nothing

Kill TempFilePath & TempFileName & FileExtStr

End If

Next sh

Set OutApp = Nothing

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub