TARİHTE FARKLI SAYFALARDA GÜN HATIRLATMA

Katılım
29 Nisan 2011
Mesajlar
6
Excel Vers. ve Dili
Kendi Halinde kullanıcı
Private Sub Workbook_Open()
Dim bugun As Long, tarih As Long, i As Long, a As Long
Dim s As Worksheet, mesaj As String


Set s = Sheets("sayfa1")

a = s.Range("a65536").End(3).Row
bugun = CLng(CDate(Date))

For i = 3 To a
tarih = CLng(CDate(s.Cells(i, "g")))
fark = tarih - bugun
If fark <= 2 And fark > 0 And s.Cells(i, "h").Value <> "bitti" Then
baslik = " Gün Hatırlatması"
mesaj = mesaj & vbCr & s.Cells(i, "b") & " ---> Bitiş tarihi : " & s.Cells(i, "h") & " Gün bitimine " & CInt(tarih - bugun) & " gün kaldı."
End If





Next i
MsgBox baslik & vbCr & mesaj, vbInformation, "KOKSAL.Net"

Set s = Nothing
i = Empty: a = Empty
bugun = Empty: tarih = Empty:
mesaj = vbNullString: baslik = vbNullString


End Sub



Set s = Sheets("sayfa1") arkadaşlar bende böyle bir kod var kullanıyorum da fakat bunun aynısını sayfa2,sayfa3,sayfa4 diye diyer sayfalardada aynı mesaj kurusu içinde yaptırmak istiyorum nasıl yapabilirim yardımcı olabilir misiniz
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba deneyebilir misiniz ?
Kod:
Private Sub Workbook_Open()
Dim bugun As Long, tarih As Long, i As Long, a As Long, x As Long
Dim s As Worksheet, mesaj As String, sayfa As String

For x = 1 To Worksheets.Count
    sayfa = Worksheets(x).Name
    Set s = Sheets(sayfa)
    
    a = s.Range("a65536").End(3).Row
    bugun = CLng(CDate(Date))
    
    For i = 3 To a
        tarih = CLng(CDate(s.Cells(i, "g")))
        fark = tarih - bugun
        If fark <= 2 And fark > 0 And s.Cells(i, "h").Value <> "bitti" Then
            baslik = " Gün Hatırlatması"
            mesaj = mesaj & vbCr & s.Cells(i, "b") & " ---> Bitiş tarihi : " & s.Cells(i, "h") & " Gün bitimine " & CInt(tarih - bugun) & " gün kaldı."
        End If
    Next i
    MsgBox sayfa & baslik & vbCr & mesaj, vbInformation, "KOKSAL.Net"
    Set s = Nothing
    i = Empty: a = Empty
    bugun = Empty: tarih = Empty:
    mesaj = vbNullString: baslik = vbNullString

Next

End Sub
 
Katılım
29 Nisan 2011
Mesajlar
6
Excel Vers. ve Dili
Kendi Halinde kullanıcı
Private Sub Workbook_Open() Dim bugun As Long, tarih As Long, i As Long, a As Long, x As Long Dim s As Worksheet, mesaj As String, sayfa As String For x = 1 To Worksheets.Count sayfa = Worksheets(x).Name Set s = Sheets(sayfa) a = s.Range("a65536").End(3).Row bugun = CLng(CDate(Date)) For i = 3 To a tarih = CLng(CDate(s.Cells(i, "g"))) fark = tarih - bugun If fark <= 2 And fark > 0 And s.Cells(i, "h").Value <> "bitti" Then baslik = " Gün Hatırlatması" mesaj = mesaj & vbCr & s.Cells(i, "b") & " ---> Bitiş tarihi : " & s.Cells(i, "h") & " Gün bitimine " & CInt(tarih - bugun) & " gün kaldı." End If Next i MsgBox sayfa & baslik & vbCr & mesaj, vbInformation, "KOKSAL.Net" Set s = Nothing i = Empty: a = Empty bugun = Empty: tarih = Empty: mesaj = vbNullString: baslik = vbNullString Next
hata veriyor
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba aşağıdaki kodu deneyiniz.
Kod:
Private Sub Workbook_Open()
Dim bugun As Long, tarih As Long, i As Long, a As Long, x As Long
Dim s As Worksheet, mesaj As String, sayfa As String

For x = 1 To Worksheets.Count
    sayfa = Worksheets(x).Name
    Set s = Sheets(sayfa)
    
    a = s.Range("a65536").End(3).Row
    bugun = CLng(CDate(Date))
    
    For i = 3 To a
        tarih = CLng(CDate(s.Cells(i, "G")))
        fark = tarih - bugun
        If fark <= 2 And fark > 0 And s.Cells(i, "h").Value <> "bitti" Then
            baslik = " Gün Hatırlatması"
            mesaj = mesaj & vbCr & sayfa & " " & s.Cells(i, "b") & " ---> Bitiş tarihi : " & s.Cells(i, "h") & " Gün bitimine " & CInt(tarih - bugun) & " gün kaldı."
        End If
    Next i
Next
    MsgBox baslik & vbCr & mesaj, vbInformation, "KOKSAL.Net"
    Set s = Nothing
    i = Empty: a = Empty
    bugun = Empty: tarih = Empty:
    mesaj = vbNullString: baslik = vbNullString

End Sub
 
Katılım
29 Nisan 2011
Mesajlar
6
Excel Vers. ve Dili
Kendi Halinde kullanıcı
Üstadım çok sağ olasın süper olmuş Allahım razı olsun emeğine sağlık işin gücün rast gitsin
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Rica ederim ayrıca iyi dileklerin için ben teşekkür ederim iyi günler :)
 
Üst