Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Haziran 2005 Çarşamba

Learn Your Age






'Module1

Dim Hesaplama As Boolean
Sub YaşınızıÖğrenin()
'Learn your age

On Error Resume Next
If MsgBox("Yaşınızı detaylı hesaplamak istiyor musunuz?", vbYesNo, "[PBİD®] Yıllık veya Detaylı [Yıl,Ay,Gün] Hesaplama") = vbYes Then
MsgBox DetayYaşHesabı(VBA.InputBox("Doğum tarihiniz [gg/aa/yyyy]", "[PBİD®] Detaylı Yaş Hesabı")) & vbNewLine & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] Hesaplanan Yaşınız..."
Else
MsgBox YıllıkYaşHesabı(VBA.InputBox("Doğum tarihiniz [gg/aa/yyyy]", "[PBİD®] Yıllık Yaş Hesabı")) & vbNewLine & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbInformation, "[PBİD®] Hesaplanan Yaşınız..."
End If
End Sub
Function YıllıkYaşHesabı(DoğumTarihi As Date)
'Calculate Year

On Error GoTo Son
DoğumTarihi = VBA.CDate(DoğumTarihi)
DoğumYıl = VBA.Year(DoğumTarihi)
DoğumAy = VBA.Month(DoğumTarihi)
DoğumGün = VBA.Day(DoğumTarihi)
BugünYıl = VBA.Year(VBA.Date)
BugünAy = VBA.Month(VBA.Date)
BugünGün = VBA.Day(VBA.Date)
If DoğumAy > BugünAy Then YıllıkYaşHesabı = BugünYıl - DoğumYıl - 1
If BugünAy = DoğumAy Then
If BugünGün >= DoğumGün Then
YıllıkYaşHesabı = BugünYıl - DoğumYıl
Else
YıllıkYaşHesabı = BugünYıl - DoğumYıl - 1
End If
End If
If BugünAy > DoğumAy Then YıllıkYaşHesabı = BugünYıl - DoğumYıl
YıllıkYaşHesabı = YıllıkYaşHesabı & " yıl"
Exit Function
Son:
YıllıkYaşHesabı = ""
End Function
Function DetayYaşHesabı(DoğumTarihi)
'Calculate Year, Month, Day

On Error GoTo Son
DoğumTarihi = VBA.CDate(DoğumTarihi)
DoğumYıl = VBA.Year(DoğumTarihi)
DoğumAy = VBA.Month(DoğumTarihi)
DoğumGün = VBA.Day(DoğumTarihi)
BugünYıl = VBA.Year(VBA.Date)
BugünAy = VBA.Month(VBA.Date)
BugünGün = VBA.Day(VBA.Date)
Yıl = BugünYıl - DoğumYıl
If DoğumAy > BugünAy Then Yıl = Yıl - 1
If BugünAy = DoğumAy And DoğumGün > BugünGün Then Yıl = Yıl - 1
Ay = BugünAy - DoğumAy
If DoğumAy >= BugünAy Then Ay = 12 + Ay
If DoğumGün > BugünGün Then Ay = Ay - 1
If Ay = 12 Then Ay = 0
AyGünü = VBA.Day((VBA.DateSerial(BugünYıl, BugünAy, 1) - 1))
Gün = BugünGün - DoğumGün
If DoğumGün > BugünGün Then Gün = AyGünü - DoğumGün + BugünGün
DetayYaşHesabı = Yıl & " Yıl, " & Ay & " Ay, " & Gün & " gün."
Exit Function
Son:
DetayYaşHesabı = ""
End Function

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul