- Katılım
- 16 Temmuz 2005
- Mesajlar
- 151
- Excel Vers. ve Dili
- 2000 türkçe
- Altın Üyelik Bitiş Tarihi
- 3.6.2022
Merhabalar;
Aşağıda eklediğim dosya ile toplu mail atmak istiyorum. Ancak döngü kurgusunda bir hata yapıyorum.
Ek teki sitede sorun yaşadığım yer TOPLU MAİL AT butonu.
Yardımlarınız için teşekkür ederim.
Not: Deneme sırasında mail atabilir.
Aşağıda eklediğim dosya ile toplu mail atmak istiyorum. Ancak döngü kurgusunda bir hata yapıyorum.
Ek teki sitede sorun yaşadığım yer TOPLU MAİL AT butonu.
Yardımlarınız için teşekkür ederim.
Not: Deneme sırasında mail atabilir.
Kod:
Private Sub CommandButton4_Click()
Sheets("Sayfa3").Select
Range("A5:CD676").Select
Selection.ClearContents
Sheets("Sayfa1").Select
ListBox1.Clear
Label6.Caption = ""
If cbaylar.Value = "" Then
MsgBox (" Lütfen AY seçiniz.")
Exit Sub
End If
Dim bak As Range
For Each bak In Sheets("rowsource").Range("n1:n" & WorksheetFunction.CountA(Range("n1:n11")))
cbmakine.Value = bak
Sheets("print2").Select
Sheets("Sayfa1").Select
ActiveSheet.Range("$A$2:$CX$1000").AutoFilter Field:=12, Criteria1:=">=" & CLng(CDate(CLng(CDate(TextBox1)))), Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(CLng(CDate(TextBox2))))
ActiveSheet.Range("$A$2:$CX$1000").AutoFilter Field:=14, Criteria1:="=" & bak
Range("A11:BA8320").Select
Range("BA11").Activate
Selection.Copy
Sheets("Sayfa3").Select
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A3:BA8000").Select
ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa3").Sort.SortFields.Add Key:=Range("L3:L1000" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa3").Sort
.SetRange Range("A3:BA8000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3").Select
ListBox1.ColumnCount = 5
ListBox1.ColumnWidths = "35;200;50;100;50"
ListBox1.Clear
Sheets("Sayfa3").Select
Dim bak2 As Range
For Each bak2 In Range("n1:n" & WorksheetFunction.CountA(Range("n1:n6500")))
If StrConv(bak2.Value, vbUpperCase) = StrConv(cbmakine.Value, vbUpperCase) Then
bak2.Select
ActiveCell.Offset(0, -2).Value = Format((ActiveCell.Offset(0, -2).Value), "dd.mm.yyyy hh.mm ")
ListBox1.AddItem
ListBox1.Column(0, sat) = (ActiveCell.Offset(0, -5).Value)
ListBox1.Column(1, sat) = (ActiveCell.Offset(0, -12).Value)
ListBox1.Column(2, sat) = (ActiveCell.Offset(0, -8).Value)
ListBox1.Column(3, sat) = (ActiveCell.Offset(0, -2).Value)
ListBox1.Column(4, sat) = (ActiveCell.Offset(0, -1).Value)
'ListBox1.Column(4, sat) = Format(ListBox1.Column(4, sat), "#,##0")
'ListBox1.Column(4, sat) = Replace(ListBox1.Column(4, sat), ",", ".")
sat = sat + 1
End If
Next bak2
Label6.Caption = ListBox1.ListCount
'''''''''''''Label8.Caption = Range("ca5").Value
Range("m500").Value = WorksheetFunction.Sum(Range("m3:m499"))
Label10.Caption = CDbl(Range("m500").Value)
Label10 = Format(Label10, "#,##0")
Sheets("Sayfa1").Select
Range("A4:CD4").Select
Selection.AutoFilter
Sheets("print2").Select
Range("A7:d3650").Select
Selection.ClearContents
Dim Data() As Variant
Dim i As Long
ReDim Data(ListBox1.ListCount - 1, 4)
For i = 0 To UBound(Data)
Data(i, 0) = ListBox1.List(i, 0)
Data(i, 1) = ListBox1.List(i, 1)
Data(i, 2) = ListBox1.List(i, 4)
ListBox1.List(i, 4) = CDbl(ListBox1.List(i, 4))
Data(i, 3) = ListBox1.List(i, 3)
'Data(i, 4) = ListBox1.List(i, 4)
'Data(i, 5) = ListBox1.List(i, 5)
'Data(i, 5) = Format(Data(i, 5), "dd.mm.yyyy")
Next i
Range("A7").Resize(i, 4) = Data
Range("c2").Value = cbmakine.Value
Range("a1").Value = TextBox1.Value & " ile " & TextBox2.Value & " TARİHLERİ ARASINDAKİ BASKI RAPORUDUR"
Range("c5").Value = Label6.Caption & " Adet "
Range("c4").Value = Label10.Caption & " Tabaka "
Application.ScreenUpdating = False
ActiveSheet.PageSetup.Orientation = xlLandscape
Sheets("print2").Select
ActiveSheet.PageSetup.Orientation = xlLandscape
Sheets("print2").Select
Application.Visible = True
Dim Sayfa As Worksheet
Dim Alan As Range
Dim daralan As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Mail tablosuna dinamiklik kazandırmak için tabloda kaç satır olduğunu bulur.
saydir = WorksheetFunction.CountIf(Range("A:A"), "<>") + 1
'Dinamik alan tanımlanır.
DinamikAlan = "A1:" & "j" & saydir
'Dinamik alan mail alanı olarak kurulur.
Set Alan = Worksheets("Print2").Range(DinamikAlan)
Set Sayfa = ActiveSheet
With Alan
.Parent.Select
Set daralan = ActiveCell
.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = (Cells(1, 3)) & " Zafer Bekyürek / Kalite Kontrol Şefi"
With .Item
.To = "uretim@rubinofset.com.tr"
.CC = "rubin@rubinofset.com.tr"
.Subject = Cells(1, 1) & " ÜRETİM RAPORUDUR "
.bcc = "oguzdemirbas@hotmail.com"
.Send
End With
End With
daralan.Select
End With
Sayfa.Select
'Sheets("Sayfa3").Select
Range("A5:CD676").Select
Selection.ClearContents
Sheets("Sayfa1").Select
ListBox1.Clear
Label6.Caption = ""
Next bak
MsgBox (" Toplu Mail Başarılı Bir Şekilde Atıldı.")
End Sub
Ekli dosyalar
-
344.3 KB Görüntüleme: 8