DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Auto_Open()
Application.OnKey "{F10}", "MakroAdı"
End Sub
Sub MakroAdı()
MsgBox "Butonsuz makro çalıştırdınız.", , "Tebrikler!"
End Sub
[COLOR="Blue"]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)[/COLOR]
If Intersect(Target, Range("F1:F" & Cells(65536, 4).End(3).Row)) Is Nothing Then Exit Sub
If Cells(Target.Row, 5) = "X" Then
[COLOR="Red"]Call email[/COLOR]
End If[SIZE="2"]
[/SIZE]If Cells(Target.Row + 1, 5) = "X" Then
[COLOR="red"]Call email[/COLOR]
End If
[COLOR="blue"]End Sub[/COLOR][SIZE="2"]
[/SIZE][COLOR="Red"]Sub email()[/COLOR]
MsgBox "MAKRO ÇALIŞTI"
[COLOR="Red"]End Sub[/COLOR]
For s = 1 To S1.Cells(Rows.Count, "E").End(3).Row
If UCase(S1.Cells(s, "E")) = "X" Then
kime = S1.Cells(s, "D")
Exit For
End If
Next s
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("F1:F" & Cells(65536, 4).End(3).Row)) Is Nothing Then Exit Sub
Call KOD
End Sub
Sub KOD()
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Dim S1 As Worksheet: Set S1 = Sheets("Mail")
yol = "C:\Users\Ahmet\Desktop\Posta\"
Dim dizi()
For i = 1 To S1.Cells(Rows.Count, "B").End(3).Row
If UCase(S1.Cells(i, "B")) = "X" Then
n = n + 1
ReDim Preserve dizi(n)
dizi(n) = yol & S1.Cells(i, "A")
End If
Next i
If Cells(ActiveCell.Row, 5) = "X" Then
kime1 = Cells(ActiveCell.Row, 4)
End If
If Cells(ActiveCell.Row + 1, 5) = "X" Then
kime2 = Cells(ActiveCell.Row + 1, 4)
End If
Dim xlOutlook As Object
Dim xlMail As Object
Set xlOutlook = CreateObject("Outlook.Application")
Set xlMail = xlOutlook.CreateItem(0)
With xlMail
.To = kime1 & " ; " & kime2
.Subject = " === E-TEBLİGAT Bilgilendirme === "
.Body = ""
For e = 1 To n
.Attachments.Add dizi(e)
Next e
.Save
.Display
[B][COLOR="Red"] .Send[/COLOR][/B]
End With
Set xlMail = Nothing
Set xlOutlook = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
With xlMail
.....
[B][COLOR="Red"].Send[/COLOR][/B]
....
End With