Kalan hapis cezasını günlük olarak verme

Merhaba değerli arkadaşlar,

Konuyu açmadan önce örnek çalışmaları inceledim, lakin kodlardan anlamadığım için konuyu açmak zorunda kaldım.

KONU: Ceza İnfaz kurumunda çalıştığım birimde kullanılmak üzere hazıladığım program bu portaldan aldığım bilgiler çerçevesinde sorunsuz çalışıyor.

Hüküm alan mahkumların cezaevine girişlerinin kaydı yapılıyor, diyelimki vatandaş 21 yıl ceza aldı bunun yatarı 14 yıldır. gün bazında 7665 tir.

Benim isteğim; Cezaevine giriş tarihi belli, toplam ceza süresi belli, yatacağı gün sayısının 2/3 oranında diğer bir metin kutusunda görünmesi, hükümlününün diğer bir metin kutusunda kronometre gibi kalan gün sayısının gün itibarı ile görünmesi.

Şimdiden teşekkür ediyorum.


FORMDA YER ALAN METİN KUTULARININ İSİMLERİ ( KULLANILAN FORMUN VERİ KAYNAĞI: Fihrist )

1) GELISTARIHI ( Cezaevine giriş tarihi)
2) TOPLAMCEZASURESI ( mahkeme tarafından toplam ceza süresi)
3) SARTLISALIVERILMESURESI (yasa gereği 1/3 oranında yapılan indirim sonrası kalan süre)
4) MAHSUBU ( daha önce nezarette ve cezaevinde yatmış olduğu süreler )
5) TAHLIYETARIHI ( mahkemece verilen toplam ceza üzerinden tahliye tarihi )
6) SARTLISALIVERMETARIHI ( 1/3 oranında yapılan indirim sonrasında kalan süreye göre tahliye tarihi)

Keşke basit bir örnek ekleseydiniz. Vakti kısıtlı olanların konuya ilgisi olmuyor böyle durumlarda.

Sayın alpeki99,

örnek eklenmiştir

(11/06/2014, 11:47)alpeki99 yazdı: Keşke basit bir örnek ekleseydiniz. Vakti kısıtlı olanların konuya ilgisi olmuyor böyle durumlarda.

Aşağıdaki kodları yeni modüle kaydedin,

Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _

Optional ShowZero As Boolean = False) As Variant



On Error GoTo Err_Diff2Dates



   Dim booCalcYears As Boolean

   Dim booCalcMonths As Boolean

   Dim booCalcDays As Boolean

   Dim booCalcHours As Boolean

   Dim booCalcMinutes As Boolean

   Dim booCalcSeconds As Boolean

   Dim booSwapped As Boolean

   Dim dtTemp As Date

   Dim intCounter As Integer

   Dim lngDiffYears As Long

   Dim lngDiffMonths As Long

   Dim lngDiffDays As Long

   Dim lngDiffHours As Long

   Dim lngDiffMinutes As Long

   Dim lngDiffSeconds As Long

   Dim varTemp As Variant



   Const INTERVALS As String = "dmyhns"



   Interval = LCase$(Interval)

   For intCounter = 1 To Len(Interval)

      If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then

         Exit Function

      End If

   Next intCounter



'Check that valid dates have been entered

   If Not (IsDate(Date1)) Then Exit Function

   If Not (IsDate(Date2)) Then Exit Function



'If necessary, swap the dates, to ensure that

'Date1 is lower than Date2

   If Date1 > Date2 Then

      dtTemp = Date1

      Date1 = Date2

      Date2 = dtTemp

      booSwapped = True

   End If



   Diff2Dates = Null

   varTemp = Null



'What intervals are supplied

   booCalcYears = (InStr(1, Interval, "y") > 0)

   booCalcMonths = (InStr(1, Interval, "m") > 0)

   booCalcDays = (InStr(1, Interval, "d") > 0)

   booCalcHours = (InStr(1, Interval, "h") > 0)

   booCalcMinutes = (InStr(1, Interval, "n") > 0)

   booCalcSeconds = (InStr(1, Interval, "s") > 0)



'Get the cumulative differences

   If booCalcYears Then

      lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _

              IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)

      Date1 = DateAdd("yyyy", lngDiffYears, Date1)

   End If



   If booCalcMonths Then

      lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _

              IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)

      Date1 = DateAdd("m", lngDiffMonths, Date1)

   End If



   If booCalcDays Then

      lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _

              IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)

      Date1 = DateAdd("d", lngDiffDays, Date1)

   End If



   If booCalcHours Then

      lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _

              IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)

      Date1 = DateAdd("h", lngDiffHours, Date1)

   End If



   If booCalcMinutes Then

      lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _

              IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)

      Date1 = DateAdd("n", lngDiffMinutes, Date1)

   End If



   If booCalcSeconds Then

      lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))

      Date1 = DateAdd("s", lngDiffSeconds, Date1)

   End If



   If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then

      varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " yıl", " yıl")

   End If



   If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then

      If booCalcMonths Then

         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

                   lngDiffMonths & IIf(lngDiffMonths <> 1, " ay", " ay")

      End If

   End If



   If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then

      If booCalcDays Then

         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

                   lngDiffDays & IIf(lngDiffDays <> 1, " gün", " gün")

      End If

   End If



   If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then

      If booCalcHours Then

         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

                   lngDiffHours & IIf(lngDiffHours <> 1, " saat", " saat")

      End If

   End If



   If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then

      If booCalcMinutes Then

         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

                   lngDiffMinutes & IIf(lngDiffMinutes <> 1, " dakika", " dakika")

      End If

   End If



   If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then

      If booCalcSeconds Then

         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _

                   lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")

      End If

   End If



   If booSwapped Then

      varTemp = "-" & varTemp

   End If



   Diff2Dates = Trim$(varTemp)



End_Diff2Dates:

   Exit Function



Err_Diff2Dates:

   Resume End_Diff2Dates



End Function

'************** Code End *****************

Metin30'un denetim kaynağına da aşağıdaki kodları ekleyiniz.

=Diff2Dates("d";Date();Format([TAHLIYETARIHI];"dd/mm/yyyy");Doğru)

Bu kod, TAHLIYETARIHI ile geçerli tarih arasındaki gün sayısını hesaplar.

Sayın ozanakkaya,

Cevap vermekte geciktiğim için affınıza sığınıyorum, Kurumdaki iş yoğunluğundan dolayı bu gecikme hasıl oldu.

Zaman ayırarak hazırlamış olduğunuz kodları hazırlamış olduğum örnek üzerinde denedim. Lakin isteğim sonuca ılaşamadım.

Sizden istirhamım;
KONU: Cezaevine yeni bir hükümlü geldiği ve kayıt işlemleri yapıldı, Şahıs 6136 sayılı kanuna muhalefetten hüküm almış olsun. Bunun cezası 4 yıl 2 aydır. Cezanın toplam süresi 1520 gündür. Şahsın cezaevinde yatması gereken süre 1013,3 gündür.

TALEP: Şahsın toplam ceza süresi olan 1520 günü TOPLAMCEZASURESI metin kutusuna yazdığımda bu sayısal veriyi tarih bazında hesaplayarak TAHLIYETARIHI' ne yazması, 1520 gün cezayı kod ile 1/3 oranında indirim yapılması, kalan 2/3 ceza süresinden MAHSUP alanına yazılan sürenin düşülerek SARTLISALIVERILMESURESI metin kutusuna eklenmesi, sonrasında bu süreyi SARTLISALIVERMETARIHI metin kutusuna cezaevine giriş tarinin üstüne eklenerek salıverilme tarini yazması, ve bunun sonucunda cezaevine giriş tarihinden itibaren Şartlı tahliyesine kadar kronometre misali geri sayım yapmasıdır.

istediğiniz hesaplamaları yapan örnek ektedir.
Cezasürehesapla diye bir form yaptım o form ile 4 yıl 2 ay gibi süreleri toplam gün sayısını hesaplamak için.
İlgili formda yıl,ay,gün yazıldığında kaç gün ceza aldığını hesaplayıp toplam ceza alanına yazıyor.
yıl,ay,ve gün değerlerinden herhangi birisi boşsa ilgili alana 0 yazıyorsunuz.
Kolay Gelsin.
,