Göreve Başlama Gününde Problem

KAZIMM · 26 Kasım 2008

5-6 günden beri formda arama yapıyorum ama istediğim sonucu elde edemedim.
sorum Textbox' girilen tarih eğer hafta sonuna (Cumartesi- Pazar) ve Resmi Tatillere ( 23 Nisan, 19 Mayıs, 29 Ekim....) rastlıyorsa göreve başlama günü sonraki iş günü olsun
ornek formu ekte gönderiyorum.

(Not :formda takvim uygulaması yöntemi ve sayfaya yazılan kodları denedim olmadı textboxlara girilen örneğide bulamadım)

uygulanan örnekler:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Or Not IsDate(Target.Value) Then Exit Sub
If Weekday(Target.Value) = [b2].Value Then
Target.Value = Target.Value + 1
MsgBox "Girdiğiniz tarih hafta sonuna geldiğinden değiştirildi."
End If
bayramlar = Sheets("Sayfa2").Range("d2:d" & Sheets("Sayfa2").[d2].End(xlDown).Row).Value
For Each tatil In bayramlar
If CDate(tatil) = CDate(Target.Value) Then
Target.Value = Target.Value + 1
MsgBox "Girdiğiniz tarih tatil gününe geldiğinden değiştirildi."
Exit Sub
End If
Next
End Sub
........

hsayar · 26 Kasım 2008

.........................................
mükerrer

hsayar · 26 Kasım 2008

bir module;

Kod:

'Bu modüldeki fonksiyonlar ile Girilen Tarihin;
'-Tatil olup olmadığını,
'-Tatil ise Cinsini (resmi,Dini,Haftasonu)
'-İlk İş gününü tespit edebilirsiniz.
'Not: Dini Tatilleri 2015 yılına kadar hesaplar
'Hsayar.
'============================================
Enum TatilTipleri
  enmHayır = 0
  enmHaftasonu = 1
  enmResmiTatil = 2
  enmDiniTatil = 3
End Enum
Function fncİlkResmiGün(Tarih As Date)
'Girilen Tarih resmi gün ise o gün değilse Sonraki İlk Resmi Gün Döner.
If Tarih = Empty Then Exit Function

sorResmiGün:
If fncTatilGünü(Tarih) = "Hayır" Then
  fncİlkResmiGün = CDate(Format(Tarih, "dd/mm/yyyy"))
Else
  Tarih = Tarih + 1
  GoTo sorResmiGün
End If
End Function
Function fncTatilGünü(Tarih As Date) As String
If Tarih = Empty Then Exit Function
Dim strCevap As TatilTipleri
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))

  strCevap = enmHayır
  If fncHaftasonuTatili(Tarih) = True Then strCevap = enmHaftasonu:  GoTo Son
  If fncResmiTatil(Tarih) = True Then strCevap = enmResmiTatil:  GoTo Son
  If fncDiniTatil(Tarih) = True Then strCevap = enmDiniTatil:  GoTo Son
Son:
Select Case strCevap
  Case Is = 0: fncTatilGünü = "Hayır"
  Case Is = 1: fncTatilGünü = "Hafta Sonu"
  Case Is = 2: fncTatilGünü = "Resmi Tatil"
  Case Is = 3: fncTatilGünü = "Dini Tatil"
End Select
End Function
Function fncHaftasonuTatili(Tarih As Date) As Boolean
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
fncHaftasonuTatili = False
If Weekday(Tarih, vbMonday) = 6 Or Weekday(Tarih, vbMonday) = 7 Then
    fncHaftasonuTatili = True
End If
End Function
Function fncResmiTatil(Tarih As Date) As Boolean
If Tarih = Empty Then Exit Function
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
ResmiTatiller = Array("01.01.1900", "23.04.1920", "19.05.1919", "30.08.1923", "29.10.1923")
  For Each TatilGunu In ResmiTatiller
    TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
      If Day(TatilGunu) = Day(Tarih) And Month(TatilGunu) = Month(Tarih) Then
        fncResmiTatil = True
        Exit For
      End If
  Next
End Function
Function fncDiniTatil(Tarih) As Boolean
If Tarih = Empty Then Exit Function
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
Select Case Year(Tarih)
  Case Is = 2008
    DiniTatilGünleri = Array("29.09.2008", "30.09.2008", "01.10.2008", "02.10.2008", "07.12.2008", "08.12.2008", "09.12.2008", "10.12.2008", "11.12.2008")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
  Case Is = 2009
    DiniTatilGünleri = Array("19.09.2009", "20.09.2009", "21.09.2009", "22.10.2009", "26.11.2009", "27.11.2009", "28.11.2009", "29.11.2009", "30.11.2009")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
  Case Is = 2010
    DiniTatilGünleri = Array("08.09.2010", "09.09.2010", "10.09.2010", "11.09.2010", "15.11.2010", "16.11.2010", "17.11.2010", "18.11.2010", "19.11.2010")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
   Case Is = 2011
    DiniTatilGünleri = Array("29.08.2011", "30.08.2011", "31.08.2011", "01.09.2011", "05.11.2011", "06.11.2011", "07.11.2011", "08.11.2011", "09.11.2011")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
   Case Is = 2012
    DiniTatilGünleri = Array("18.08.2012", "19.08.2012", "20.08.2012", "21.08.2012", "24.10.2012", "25.10.2012", "26.10.2012", "27.10.2012", "28.10.2012")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
   Case Is = 2013
    DiniTatilGünleri = Array("07.08.2013", "08.08.2013", "09.08.2013", "10.08.2013", "14.10.2013", "15.10.2013", "16.10.2013", "17.10.2013", "18.10.2013")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
   Case Is = 2014
    DiniTatilGünleri = Array("27.07.2014", "28.07.2014", "29.07.2014", "30.07.2014", "03.10.2014", "04.10.2014", "05.10.2014", "06.10.2014", "07.10.2014")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
   Case Is = 2015
    DiniTatilGünleri = Array("16.07.2015", "17.07.2015", "18.07.2015", "19.07.2015", "22.09.2015", "23.09.2015", "24.09.2015", "25.09.2015", "26.09.2015")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            fncDiniTatil = True
            Exit For
        End If
    Next
    Case Else
    'http://www.takvim.com/resmi_tatiller.php
    'Adresinden kontrol ederk genişletebilirsiniz.
End Select
End Function

Userformunuza 3 adet textbox, 1 adet command buton ekledikten sonra
txt_IzinBasla adını iznin başladığı tarihi girdiğiniz textboxa
txt_IzinSure adını izinin süresini girdiğiniz textboxa
txt_IzinBitis adını Görev başlangıç tarihinin yazılacağı textboxa
cmd_IzinHesap adını hesaplamayı yaptıracağınız commandbutona veriniz.

Kod:

Private Sub cmd_IzinHesap_Click()
  Dim datİzinBitis As Date
  datİzinBitis = (CDate(txt_IzinBasla) + txt_IzinSure)
  datİzinBitis = fncİlkResmiGün(datİzinBitis)
  txt_IzinBitis = Format(datİzinBitis, "DD/MM/YYYY")
End Sub

Aşağıdaki fonksiyon while wend yada do loop/until gibi birşey ilede düzenlebilir ama bilmediğim için böyle yaptım. bilen biri yol gösterirse sevinirim.

Kod:

Function fncİlkResmiGün(Tarih As Date)
'Girilen Tarih resmi gün ise o gün değilse Sonraki İlk Resmi Gün Döner.
If Tarih = Empty Then Exit Function

sorResmiGün:
If fncTatilGünü(Tarih) = "Hayır" Then
  fncİlkResmiGün = CDate(Format(Tarih, "dd/mm/yyyy"))
Else
  Tarih = Tarih + 1
  GoTo sorResmiGün
End If

hsayar · 27 Kasım 2008

Sn Kazım işinize yaradımı?

hsayar · 27 Kasım 2008

fncİlkResmiGün fonksiyonunu isterseniz değiştirebilirisiniz.

Kod:

Function fncİlkResmiGün(Tarih As Date)
'Girilen Tarih resmi gün ise o gün değilse Sonraki İlk Resmi Gün Döner.
If Tarih = Empty Then Exit Function

  While fncTatilGünü(Tarih) <> "Hayır"
    Tarih = Tarih + 1
  Wend
  fncİlkResmiGün = CDate(Format(Tarih, "dd/mm/yyyy"))
    
End Function

KAZIMM · 27 Kasım 2008

Teşekür Ederim.

İşyerindeki Problemlerden dolayı mesajlara bakamadım. çok güzel olmuş elinize sağlık, Allah Razı Olsun.

hsayar · 27 Kasım 2008

işinize yaradığına sevindiğim.

Göreve Başlama Gününde Problem

KAZIMM

Ekli dosyalar

hsayar

hsayar

Ekli dosyalar

hsayar

hsayar

KAZIMM

hsayar