دالة حساب العمر بالميلادي او الهجري بعدة تعيينات وبكود صغير

[عبدالله باقشير]

السلام عليكم


دالة حساب العمر بالميلادي او الهجري

كود الدالة

Option Explicit
'          بسم الله الرحمن الرحيم               "
'============================================"
'   دالة حساب العمر بالتقويم الميلادي او الهجري  "
'============================================"
'Mydate_Birth:     تاريخ الميلاد بالميلادي       "
'============================================"
'Mydate: التاريخ الذي تريد احتساب العمر عنده "
'                 بالاختيار                   "
'    اذا كان فارغاً : سيتم تعيين تاريخ اليوم   "
'============================================"
'Y_M_D  :   بالإختيار  يوم او شهر او سنة      "
'   D   :            يوم                     "
'   M   :            شهر                     "
'   Y   :            سنة                     "
'        اذا كان فارغاً : سيتم إظهار الكل     "
'============================================"
'MyCalendar:    التقويم المستخدم لحساب العمر    "
'True :   او اي رقم سيتم تعيين التقويم الهجري   "
'False:          او اذا كان فارغاً            "
'         سيتم تعيين التقويم الميلادي            "
'============================================"
Function kh_count_y_m_d(Mydate_Birth As Date, Optional Mydate_Now _
, Optional Y_M_D As String = "Y_M_D", Optional MyCalendar As Boolean)
Dim Mydate As Date, KH_Calendar As Integer
Dim D_1 As Integer, D_2 As Integer, M_1 As Integer, M_2 As Integer, Y_1 As Integer _
, Y_2 As Integer, D As Integer, M As Integer, Y As Integer
If IsDate(Mydate_Now) Then Mydate = Mydate_Now Else Mydate = Date
If IsDate(Mydate_Birth) And CDate(Mydate_Birth) <= CDate(Mydate) Then
    KH_Calendar = Calendar
    If MyCalendar = True Then Calendar = 1 Else Calendar = 0
    D_1 = Day(Mydate): D_2 = Day(Mydate_Birth)
    M_1 = Month(Mydate): M_2 = Month(Mydate_Birth)
    Y_1 = Year(Mydate): Y_2 = Year(Mydate_Birth)
    If D_1 >= D_2 Then D = D_1 - D_2: M = 0 Else D = D_1 + 30 - D_2: M = -1
    If M_1 + M >= M_2 Then M = M_1 + M - M_2: Y = 0 Else M = M_1 + M + 12 - M_2: Y = -1
    Y = Y_1 + Y - Y_2
    If Y_M_D <> "Y" Or Y_M_D <> "M" Or Y_M_D <> "D" Then kh_count_y_m_d = Y & "y-" & M & "m-" & D & "d"
    If Y_M_D = "Y" Then kh_count_y_m_d = Y
    If Y_M_D = "M" Then kh_count_y_m_d = M
    If Y_M_D = "D" Then kh_count_y_m_d = D
    Calendar = KH_Calendar
End If
End Function

___________________________________.rar

[أكرم الغامدي]

أخي الحبيب خبور، كما عودتنا عليك، مبدع كعادتك.

لا حرمنا الله من إبداعاتك المتجددة.

لقد قمت بمقارنة النتائج، وقد كانت متشابهة، مما جعلني أطمئن على مستقبلي المهني.

[محمدي عبد السميع]

حفظكم الله ورعاكم

تم تعديل يناير 22, 2009 بواسطه mohammadey1

[جلال محمد]

اخى خبور

جزاك الله كل خير

عمل رائع ومتميز زادك الله من علمه

[safwatscc]

السلام عليكم

الاخ خبور

بارك الله فيك وجعلة فى ميزان حسناتك ونفع بك الامة

ارجوا الا اسقل عليك

ارجو ا عمل دالة السن لكى تتناسب مع شيت الدرجات الخاص بالطلاب

لان بهذا الشيت اسم الطالب ثم تاريخ الميلاد ويطلب السن فى مثلا 1 / 10 / 2009

وارجو ا عندما نكتب تاريخ الميلاد فى الثلاث خانات الاولى يظهر فى الثلاث خانات الاخرى السن فى التاريخ المحدد

واحيانا يكون عدد الطلاب كبير يتجازو الاف فبالطريقة المعروضة من سيادتكم تكون صعبا عليا حساب اسم اسم

عموما عزرا اخى الملف المرفق يوضح اكثر

وبارك الله فيك وسامحنى ان تعبتك معى

_________.rar

[عبدالله باقشير]

السلام عليكم

تم تعديل كود الدالة ليتناسب مع طلبك

بشكل سريع

Function kh_y_m_d(D_Birth As Integer, M_Birth As Integer, Y_Birth As Integer, D_1 As Integer, M_1 As Integer, Y_1 As Integer, Optional Y_M_D As String)
   Dim D As Integer, M As Integer, Y As Integer
    If D_1 >= D_Birth Then D = D_1 - D_Birth: M = 0 Else D = D_1 + 30 - D_Birth: M = -1
    If M_1 + M >= M_Birth Then M = M_1 + M - M_Birth: Y = 0 Else M = M_1 + M + 12 - M_Birth: Y = -1
    Y = Y_1 + Y - Y_Birth
    If Y_M_D <> "Y" Or Y_M_D <> "M" Or Y_M_D <> "D" Then kh_y_m_d = Y & "y-" & M & "m-" & D & "d"
    If Y_M_D = "Y" Then kh_y_m_d = Y
    If Y_M_D = "M" Then kh_y_m_d = M
    If Y_M_D = "D" Then kh_y_m_d = D
End Function

تفضل المرفق

_________.rar

[safwatscc]

الاخ خبور

تعجز الكلمات عن الشكر لك

و بارك الله فيك

[قصي]

اذا كان فارغاً : سيتم إظهار الكل

عايزينه اذا كان فارغ يظل فارغ وشكرا

[قصي]

للرفع

[عبدالله باقشير]

السلام عليكم

الاخ / قصي ------------حفظه الله

ما دمت تريده فارغا فلماذا تستخدم الدالة في الخلية اساسا ؟؟؟

اجعلها فارغة فلن تجد شيئا

هذا حسب ما فهمته من تعليقك

[ابوصبرى]

[الأخ والأستاذ الفاضل]أ/ خبور مشكور جدا جدا على هذه الروائع والافكار النيرة

فجعلها الله فى ميزان حسناتك ولك منا كل الشكر والتقدير

وربنا مايحرمناش أبدا منك

[قصي]

السلام عليكم

الاخ / قصي ------------حفظه الله

ما دمت تريده فارغا فلماذا تستخدم الدالة في الخلية اساسا ؟؟؟

اجعلها فارغة فلن تجد شيئا

هذا حسب ما فهمته من تعليقك

الاخ خبور ........... حفظه الله

اسماء الطلاب كثيرة جدا ويوجد نعض الطلاب ليس عندهم شهادات ميلاد

سنستدعي بيانات الطلاب ونصورهم في كشوف ..... ونستعد لكتابة عمر الطالب الذي لم يحضر شهادة ميلاده

وعندما يحضر الطالب شهادة ميلاده سندخل عمره يدويا

[الجزيرة]

أخي عبد الله

مبدع اينما كنت

كم استفدنا وما زلنا نستفيد من ابداعكم

[الضيغم]

ابدعت بارك الله فيك

[no0o0u]

مرحبا 

اخواني الافاضل احتاج ملف اكسل يعمل على حساب العمر بالهجري  والميلادي فقط دون اي اضافات اخرى 

الخانات 

هل بالامكان توفير طلبي  اكون لكم شاكرة

بالاضافه الى ملف يتم احتساب النسبه في حاله كانت 25% او 75% او 50%

الخانات تكون كالتالي 

المبالغ

النسبة المطلوبة 

النتيجه 

[Ali Mohamed Ali]

اهلا بك في المنتدى 

من فضلك ارفع ملف لما تريد وشرح المطلوب عليه بكل دقة فلا يمكن العمل على التخمين

[no0o0u]

ابي ملف اكسل اقدر اشتغل عليه لدوام 

 

الاول : ملف تحويل التواريخ من ميلادي الى هجري والعكس

الثاني : حساب العمر بالميلادي والهجري , وحساب العمر حسب تاريخ يوم معين

الثالث : حساب المبالغ على حساب النسبه يعني اضيف المبالغ وانا راح احاسب العميل على 75% فتظهر النتيجه اضيف المبالغ كامله قبل التعويض وتحسب لي نتيجة التعويض مباشرة على حسب القيمه بالمية 

 

لكني ابيه صفحه اكسل عامه دون مسميات لشركة رسميه

 

[Ali Mohamed Ali]

لا يمكن العمل على التخمين عليك برفع الملف وشرح المطلوب عليه بكل دقة

[no0o0u]

ارجو ان تكون الصورة واضحه حيث تم ادخال التاريخ في الخانه ولم يتم احتساب العمر ارجو تعديلها وادراج الملف