Soru Tarih Geçişleri (vba)

[MESUT K]

Herkese Selamlar
Dosya içerisinde detaylı olarak sorunumu açıkladım.Sorunumun kodla çözümü için yardımınızı istiyorum

Saygılarımla

link=https://dosya.co/8tsnyu16grp5/tarih_geçişleri.xlsm.html

 

[YUSUF44]

Önceki sorunuzdan faydalanarak ilgili sayfanın kod bölümünde kullanılacak kod:

Private Sub Worksheet_Activate()
    yg1 = DateSerial(Year(Date), 3, 16)
    yg2 = DateSerial(Year(Date), 4, 15)
    yaz1 = yg2 + 1
    yaz2 = DateSerial(Year(Date), 10, 15)
    kg1 = yaz2 + 1
    kg2 = DateSerial(Year(Date), 11, 15)
    If Date >= yg1 And Date <= yg2 Then
        [D6] = "YAZA GEÇİŞ"
    ElseIf Date >= yaz1 And Date <= yaz2 Then
        [D6] = "YAZ"
    ElseIf Date >= kg1 And Date <= kg2 Then
        [D6] = "KIŞA GEÇİŞ"
    Else
        [D6] = "KIŞ"
    End If
End Sub

ThisWorkBook / BuÇalışmaKitabı bölümünde kullanılacak kod:

Private Sub Workbook_Open()
    yg1 = DateSerial(Year(Date), 3, 16)
    yg2 = DateSerial(Year(Date), 4, 15)
    yaz1 = yg2 + 1
    yaz2 = DateSerial(Year(Date), 10, 15)
    kg1 = yaz2 + 1
    kg2 = DateSerial(Year(Date), 11, 15)
    If Date >= yg1 And Date <= yg2 Then
        [D6] = "YAZA GEÇİŞ"
    ElseIf Date >= yaz1 And Date <= yaz2 Then
        [D6] = "YAZ"
    ElseIf Date >= kg1 And Date <= kg2 Then
        [D6] = "KIŞA GEÇİŞ"
    Else
        [D6] = "KIŞ"
    End If
End Sub

 

[YUSUF44]

#2 nolu mesajımdaki kodda kışa geçiş tarihlerindeki hata düzeltilmiştir.

 

[MESUT K]

Kod çalışıyor.Yusuf Bey çok çok teşekkür ederim.Elinize sağlık

 

[YUSUF44]

BuÇalışmaKitabı/ThisWorkBook kısmındaki kod şöyle olmalı:

Private Sub Workbook_Open()
    yg1 = DateSerial(Year(Date), 3, 16)
    yg2 = DateSerial(Year(Date), 4, 15)
    yaz1 = yg2 + 1
    yaz2 = DateSerial(Year(Date), 10, 15)
    kg1 = yaz2 + 1
    kg2 = DateSerial(Year(Date), 11, 15)
    If Date >= yg1 And Date <= yg2 Then
        Sheets("Sheet1").[D6] = "YAZA GEÇİŞ"
    ElseIf Date >= yaz1 And Date <= yaz2 Then
        Sheets("Sheet1").[D6] = "YAZ"
    ElseIf Date >= kg1 And Date <= kg2 Then
        Sheets("Sheet1").[D6] = "KIŞA GEÇİŞ"
    Else
        Sheets("Sheet1").[D6] = "KIŞ"
    End If
End Sub