لدي حقلين إذا كان أحدهما هجري يكون الآخر ميلادي ؟

[ليـــــــــــــنا حداد]

السلام عليكم ورحمة الله وبركاته،،،

الأخوة المشرفين والأعضاء لكم مني اطيب التحيات ،،،

أرجو الاستفادة من خبرتكم

أنا عندي شاشات فيها حقلي تاريخ بالهجري وبالميلادي ، فهل هناك طريقة تغنيني عن ادخال كل الحقلين وأكتفي بادخال واحد فقط ، كأن ادخل الهجري ويحول هو تلقائياً تعبئة الحقل الميلادي ،،، وشكراً

[rudwan]

توجد دوال مميزه لأستاذنا أبو هادي خاصه بتحويل التاريخ

أنسخي هذه الأكواد في وحده نمطه مستقله

Function GetSysHijri(ByVal HijriDate As Variant, _
                     Optional ByVal FormatPic As String = "dd/mm/yyyy") As String
  Dim oKey As Variant
  Dim AddDays As Integer
  Dim CurrCal As Byte
  Dim NewDate As String
  Dim ddd As String
  Dim dddd As String
  Dim Pos As Integer On Error Resume Next

  CurrCal = Calendar
  Calendar = vbCalHijri

  HijriDate = CDate(HijriDate)
  If Not IsDate(HijriDate) Then Exit Function

  If Year(HijriDate) = Year(Date) And _
     Month(HijriDate) = Month(Date) Then
     Set oKey = CreateObject("Wscript.Shell")
     Select Case oKey.RegRead("HKEY_CURRENT_USER\control Panel\International\AddHijriDate")
       Case "AddHijriDate-2": AddDays = -2
       Case "AddHijriDate":   AddDays = -1
       Case "":               AddDays = 0
       Case "AddHijriDate+1": AddDays = 1
       Case "AddHijriDate+2": AddDays = 2
     End Select
     Set oKey = Nothing
  Else
    AddDays = 0
  End If

  ddd = format(HijriDate + AddDays, "ddd")
  dddd = format(HijriDate + AddDays, "dddd")
  NewDate = format(HijriDate + AddDays, FormatPic)

  If ddd <> format(HijriDate, "ddd") Then
    Do While True
      If NewDate Like "*" & dddd & "*" Then
        Pos = InStr(1, NewDate, dddd)
        NewDate = Left(NewDate, Pos - 1) & _
                  format(HijriDate, "dddd") & _
                  Mid(NewDate, Pos + Len(dddd))
      ElseIf NewDate Like "*" & ddd & "*" Then
        Pos = InStr(1, NewDate, ddd)
        NewDate = Left(NewDate, Pos - 1) & _
                  format(HijriDate, "ddd") & _
                  Mid(NewDate, Pos + Len(ddd))
      Else
        Exit Do
      End If
    Loop
  End If

  GetSysHijri = NewDate
  Calendar = CurrCal
End Function

Function GetGreg(ByVal inDate As Variant, _
                 Optional ByVal FormatPic As String = "dd/mm/yyyy") As String
  Dim CurrCal As Byte On Error Resume Next

  inDate = CDate(inDate)
  If IsDate(inDate) Then
    CurrCal = Calendar
    Calendar = vbCalGreg
    GetGreg = format(inDate, FormatPic)
    Calendar = CurrCal
  End If
End Function

Function GetHijri(ByVal inDate As Variant, _
                  Optional ByVal FormatPic As String = "dd/mm/yyyy") As String
  Dim CurrCal As Byte On Error Resume Next

  inDate = CDate(inDate)
  If IsDate(inDate) Then
    CurrCal = Calendar
    Calendar = vbCalHijri
    GetHijri = format(inDate, FormatPic)
    Calendar = CurrCal
  End If
End Function

و الآن من النموذج , نستخدم الداله

GetGreg(MyDate)

للحصول على تاريخ ميلادي مقابل للتاريخ الهجري mydate و الداله :

GetHijri(mydate)

للحصول على تاريخ هجري مقابل للتاريخ الميلادي

لمن توجد ملاحظه , الأكسس لايقبل الا تاريخ واحد فقط , يعني اذا كان التاريخ الأصلي هجري

و تنسيقه تاريخ , و تريدين اضافة حقل آخر للتاريخ الميلادي , فيجب أن يكون هذا الحقل الآخر تنسيقه نص و ليس تاريخ , و الا لن يعطي نتيجه صحيحه

و بالعكس اذا كان التاريخ ميلادي و يوضع حقل آخر نص لتخزين التاريخ الهجري

تم تعديل ديسمبر 10, 2005 بواسطه rudwan

[malik68]

كثر الف خيرك على المشاركة القيمة وحتى تكتمل الرؤية بالنسبة لي ارجو التوضيح بالإسهاب بعد نسخ الكود اين الصقه هل في الوحدات النمطيه الخاصة بالأكسل أم الاكسس وكيف يتم ذلك ارجو الإفادة مشكورا

[ليـــــــــــــنا حداد]

يعطيك العافية :

في ناس كثيرة ما تفهم إلى بخطوة خطوة وأنا أولهم وانت يا أخ رضوان عارفنا فلا تحرجنا وتخلينا نسأل كل مرة وين اضع الكود ،

الشيء الثاني هو عندما أفتح وحدة نمظية جديدة وألصقه يأخذ أكثر من وحدة وعند حفظها يطالبني بتسميتها فهل يجب أن أسميها اسماء معينة ولا 1 و 2 يكفوا مثلاً ،

ملاحظة ما أريده هو أن احول تاريخ الهجري إلى ميلادي وعندي حقلين في الجدول الواحد كلهما صيغتهما تاريخ ووقت فماذا تقصد عندما تقول أن الاكسس لا يقبل ،،،

وشكراً

[rudwan]

الأخ مالك - الأخت لينا

هذا مثال ع السريع

الوحدات النمطيه كلها تنقل الى موديول جديد

بمجرد كتابة تاريخ في النموذج , يعطي المقابل بالهجري

لاحظوا أن تنسيق التاريخ هجري , أما الميلادي نص

ConvertDate.rar

[ليـــــــــــــنا حداد]

الأخ رضوان :

السلا م عليكم ورحمة الله وبركاته،

سأقول لك الخطوات التي عملتها خطوة خطوة :

أولاً قمت بانشاء مديول جديد ولصقت فيه الكود الطويل الموجود في هذه المشاركة , ثم ذهبت إلى أحد الجداول عندي وغيرت اسماء حقلي تاريخ الصادر والموافق على mydate و gregdate مع تغير صغية الميلادي إلى نصـ، ثم في نموذج الصادر غيرت أسماء الحقلين مع العلم أنني جعلت محل اسم الخلية lebel وبعدها ذهبت إلى الحدث في After Update ووضعت الكود

Private Sub MyDate_AfterUpdate()
Me.GregDate = GetGreg([MyDate])

وهكذا ولكن مع الأسف لم تعمل معي هذه الطريقة ،،، هل يوجد أي خلل أو ناقص فيما قمت به ، لأن حقل الميلادي يبقى فارغاً بعد تعبئة الهجري ، السؤال الثاني هو هل يجب علي أن أغير أسماء الحقول ام أنني ممكن أن أتركها كما هي ومن ثم أغيرها في الكود ،،، وشكراً

تم تعديل ديسمبر 17, 2005 بواسطه rudwan

[rudwan]

العمل صحيح لكن تأكدي أن يكون حقل التاريخ الهجري اسمه فعلا MyDate ( اسم الحقل و ليس مصدر البيانات ) .

لأن أي كود يتعامل مع اسم الحقل و ليس مع مصدر بياناته في الجدول

[ليـــــــــــــنا حداد]

الأخ رضوان :

صحيح أن أسماء الحقول مختلفة ولكن لا يمكن أن أضع اسم mydate في قاعدة بيانات عربية لذا لا بد من تغيير عبارة mydate إلى التاريخ وعبارة gregdate إلى الموافق وهكذا ، وأنا حاولت كثير في الكود أغير العبارات واسماء الجداول بس مع الأسف ما ليقيت شيء واضح فأرجوا أن توضح الفكرة أكثر ،،، وشكراً

[rudwan]

الفكره نفسها لم تتغير , و لكن الله يعينك على الأسماء العربيه , أنا دائما أنصح بكتابة أسماء الحقول و الجداول بالانكليزيه لأجل موضوع الأكواد بالتحديد , لكن على كل حال عليكي :

1 - اما أن تغيري اسماء الحقول و الجداول الى الانكليزيه و هذا الخيار المفضل

2 - أو نسخ الكود نفسه , و فقط بين القوسين المربعين يتم تغيير اسم الحقل الانكلزيي الى الاسم العربي , مثلا :

[التاريخ]

و اذا لم ينجح معك ارسليه لي