Excel mail makro

Merhabalar herkese,

Makro yapabilen arkadaşları özele bekliyorum. Yapamadığım bir makro bulunmaktadır

Teşekkürler.

Merhaba,

Vba kısmına bir modül ekleyiniz. ve şu kodu içerisine kopyalayıp mail adresleri kısmını düzenleyiniz. Excel kısmına da form denetimi kısmından düğme olarak ekleyiniz.

Sub SendShByEmail()
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim ShName As String, WbName As String

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual

Sheets(ActiveSheet.Name).Copy

ShName = ActiveSheet.Name

ActiveSheet.DrawingObjects.Delete
Dim X As Range
For Each X In [a1:ar56]
If X.HasFormula = True Then
X.Value = X.Value
End If
Next X

WbName = ThisWorkbook.Path & "" & ShName & ".xls"

ActiveWorkbook.SaveAs WbName, FileFormat:=-4143
ActiveWorkbook.Close False


Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = "adınız@mailadresiniz.com" & ";" & "adınız@mailadresiniz.com" & ";" & "adınız@mailadresiniz.com" & ";" & "adınız@mailadresiniz.com" & ";" & "adınız@mailadresiniz.com"
.Subject = "Maildeki Konu Kısmı"
.Body = "Mail İçeriği. yazısı."
.Attachments.Add WbName
.Save
.Send
End With
Set NewMail = Nothing
Set OutApp = Nothing
Set VBComp = Nothing

Kill WbName

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub