- Katılım
- 3 Haziran 2012
- Mesajlar
- 16
- Excel Vers. ve Dili
- office xp
Arkadaşlar sorunumu gayet açık bir şekilde belirtmeye çalışacağım. Yarımcı olanlara sonsuz teşekkürler.
A1 hücresindeki sayı 180
Bu sayı belirli periyotlarda dışarıdan çekilen verilere göre 1er 1er artıyor.
Yapmak istediğim ise şu şekilde.
A1 hücresindeki değer +1 arttığında işlemi yap.
For Each HÜCRE In Range("A1")
If UCase(HÜCRE.Value) = "180" Then
//işlemin yapılacağı yer//
End If
Örnek olarak yukarıdaki formülde A1 hücresindeki değer 180'e eşit olduğunda işlemi yapıyor.
Benim yapmak istediğimde bu sayı her arttığında işlemi yapması.
Makro her 10 saniyede bir yenilenmektedir. If UCase(HÜCRE.Value) = "180" Then Buraya öyle bir kod yazmalıyızki A1 her arttığında işlemi yapacak ve yeni değer 181 yapıp onun üzerinden devam edecek.
Örnek olarak açıklayacak olursam o an makro çalıştığında değer 180 ise 10 saniyede bir yenilenmeye devam edecek. Değer 181 olduğunda işlemi belirttiğim alanda yapacak. Ve yine çalışmaya devam edecek 10 saniye aralıklarla. Değer 181 olduktan 10 saniye sonra bu defa hesabı 181 üzerinden yapacak. 182 olduğunda tekrar çalışacak. Eğer 181 ise boş geçecek.
Kodun geneli şu şekildedir:
Sub OutlookMailGönder()
yeniden:
Dim duraksama, başla, dur
duraksama = 10
başla = Timer
Do While Timer < başla + duraksama
DoEvents
Loop
dur = Timer
Dim HÜCRE As Range
For Each HÜCRE In Range("A1")
If UCase(HÜCRE.Value) = "180" Then
Dim OutApp As Object
Dim OutMail As Object
Dim MsgBody As String
On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
OutApp.Visible = True
Set OutMail = OutApp.CreateItem(0)
'****************************************************
MsgBody = "Sayfa Güncellenmiştir<br><br><br>" & _
"İyi Çalışmalar."
'****************************************************
With OutMail
.To = "example@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Günlük Satış Raporu"
.HTMLBody = MsgBody
'.Attachments.Add ("C:\test.txt")
'.Display
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next
GoTo yeniden:
End Sub
A1 hücresindeki sayı 180
Bu sayı belirli periyotlarda dışarıdan çekilen verilere göre 1er 1er artıyor.
Yapmak istediğim ise şu şekilde.
A1 hücresindeki değer +1 arttığında işlemi yap.
For Each HÜCRE In Range("A1")
If UCase(HÜCRE.Value) = "180" Then
//işlemin yapılacağı yer//
End If
Örnek olarak yukarıdaki formülde A1 hücresindeki değer 180'e eşit olduğunda işlemi yapıyor.
Benim yapmak istediğimde bu sayı her arttığında işlemi yapması.
Makro her 10 saniyede bir yenilenmektedir. If UCase(HÜCRE.Value) = "180" Then Buraya öyle bir kod yazmalıyızki A1 her arttığında işlemi yapacak ve yeni değer 181 yapıp onun üzerinden devam edecek.
Örnek olarak açıklayacak olursam o an makro çalıştığında değer 180 ise 10 saniyede bir yenilenmeye devam edecek. Değer 181 olduğunda işlemi belirttiğim alanda yapacak. Ve yine çalışmaya devam edecek 10 saniye aralıklarla. Değer 181 olduktan 10 saniye sonra bu defa hesabı 181 üzerinden yapacak. 182 olduğunda tekrar çalışacak. Eğer 181 ise boş geçecek.
Kodun geneli şu şekildedir:
Sub OutlookMailGönder()
yeniden:
Dim duraksama, başla, dur
duraksama = 10
başla = Timer
Do While Timer < başla + duraksama
DoEvents
Loop
dur = Timer
Dim HÜCRE As Range
For Each HÜCRE In Range("A1")
If UCase(HÜCRE.Value) = "180" Then
Dim OutApp As Object
Dim OutMail As Object
Dim MsgBody As String
On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
OutApp.Visible = True
Set OutMail = OutApp.CreateItem(0)
'****************************************************
MsgBody = "Sayfa Güncellenmiştir<br><br><br>" & _
"İyi Çalışmalar."
'****************************************************
With OutMail
.To = "example@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Günlük Satış Raporu"
.HTMLBody = MsgBody
'.Attachments.Add ("C:\test.txt")
'.Display
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next
GoTo yeniden:
End Sub