هذا Function يعمل على Access أو أي تطبيق من تطبيقات الاوفيس كذلك يعمل على VB أرجو أن يفيدكم :
Public Function TransDate(thedate As Date, TypeTrans As Integer) As String 'TypeTrans: Hijri = 1, Gerg = 0 Dim v As Byte v = VBA.Calendar VBA.Calendar = TypeTrans TransDate = CStr(thedate) VBA.Calendar = v End Function
حيث يقوم بعملية التحويل ويعطي النتيجة كنص
تم تعديل هذه المشاركة بواسطة مهند عبادي في 9 مايو 2004 في 19:08
طريقة ذكية ، اشكرك عليها . ولكن هناك سؤال .
لماذا CStr بما أن thedate هو متغير من نوع تاريخ .
جزاكم الله خيرا ا مهند
لا مستحيل مع إصرار ، ولا يأس مع إيمان ، ولا جهل مع نور الرحمن
Nothing is impossible with this
CStr يحول من تاريخ إلى نص
ففي هذا التابع بعد تغيير نوع التقويم نحول قيمة التاريخ (حيث يكون بالصيغة التي نريدها ميلادي أو هجري) إلى نص من أجل تثبيت هذه الصيغة .. لأن إبقاؤه في صيغة Date لا يفيدنا بسبب تغير صيغته مرة ثانية بعد تنفيذ السطر الأخير : VBA.Calendar = v حيث نعيد نوع التقويم كما كان
دائما في مجال دوال التاريخ, هذه دالة متطورة لحساب التاريخ
Function AgeCount(varDOB As Variant, Optional varDate As Variant) As String
'*******************************************
' PURPOSE: Determines the difference between two dates.
'
' ARGUMENTS: (will accept either dates (e.g., #03/24/00#) or
' strings (e.g., "03/24/00")
' varDOB: The earlier of two dates.
' varDate: The later of two dates.
'
' RETURNS: A string as years.months.days, e.g., (17.6.21)
' NOTES: To test: Type ? agecount("03/04/83", "03/23/00")
' in the debug window. The function will
' return "17.0.19".
' Type ? agecount("03/04/83") in the debug
' window and the function substitutes the
' system date for varDate and returns
' (as of 12/1/03) "20.8.27"
'*******************************************
Dim dteDOB As Date, dteDate As Date
Dim intOldYears As Integer, intNuYears As Integer
Dim intOldMonths As Integer, intNuMonths As Integer
Dim intOldDays As Integer, intNuDays As Integer
Dim intyears As Integer, intmonths As Integer, intdays As Integer
Dim AgeHold As String
'use system date if varDate not supplied
varDate = IIf(IsMissing(varDate), Date, varDate)
dteDOB = DateValue(varDOB)
dteDate = DateValue(varDate)
intOldYears = year(dteDOB)
intOldMonths = Month(dteDOB)
intOldDays = Day(dteDOB)
intNuYears = year(dteDate)
intNuMonths = Month(dteDate)
intNuDays = Day(dteDate)
If intNuDays < intOldDays Then
intNuDays = intNuDays + 30
intNuMonths = intNuMonths - 1
End If
If intNuMonths < intOldMonths Then
intNuMonths = intNuMonths + 12
intNuYears = intNuYears - 1
End If
intyears = intNuYears - intOldYears
intmonths = intNuMonths - intOldMonths
intdays = intNuDays - intOldDays
AgeHold = LTrim(str(intyears)) & "." & LTrim(str(intmonths)) & "." & LTrim(str(intdays))
AgeCount = AgeHold
End Functionهذا الموضوع مغلق.