چگونه تاریخ اکسس را شمسی کنیم

[منصور بزرگمهر]

مشکل تاریخ شمسی در اکسس
پاره ای از دوستان زحمت کشیده اند، و توابع تبدیل تاریخ را ایجاد نموده اند، ولی برای ذخیره این تاریخها باید در ستون متنی انها را نوشت، و بدیهی است که این نوع نوشتن را نمی توان مورد سنجش تاریخی قرار داد، در حالی که فرمت تاریخ خود اکسس برای این منظور آمده است، و البته دهها تابع تو کار برای دسترسی و پرس جو این نوع فیلد، ولی در مورد فیلد متنی نمی توان ان تابع را بکار برد. بعضیها راه حل را در داشتن دو ستون تاریخ شمسی و تاریخ میلادی در کنار ان دانسته اند و از طریق برنامه تاریخ شمسی را گرفته و تبدیل به میلادی نمود، و سپس پرسجو را ایجاد نمود، این راه حل با اینکه درست می باشد، ولی کارآمد نمی باشد، چرا که توابع فوق را می توان از طریق فیلتر پیشرفته فرم اکسس نیز وارد نمود و نوعی پرسجو سریع(کاربر) بدست اورد، و این موقع دوباره نمی توان در ستون متنی تاریخ شمسی تابع یا عملگری را وارد و فیلتر نمود، و مشکلات بیشمار دیگری در مورد تاریخ وجود دارد، که بیان انها سر به فلک می زند. نکته دیگری که نیز وجود دارد، این می باشد، که بعضی از شرکتهای ایرانی نظیر نوین یا پارسا و ... برنامه های فوق را تاریخ شمسی نموده اند، می خواستم بدانم انها چگونه این کار را انجام داده، تا مشکل بزرگ تاریخ در اکسس حل گردد.(در MSDN در مورد تاریخ سایر کشورها و توابه فرهنگ توضیحاتی داده است، که سر در نیاوردم - برای آشنائی بیشتر در محل پرس جو بنویسیدHijri Calendar Iran )
البته حتی متاسفانه تاریخ این شرکتها نیز درست نبوده و بعضی مواقع اشتباه عمل نموده، (مثال 31/2/xxxx را قبول نمی کند) و باعث دردسر های بیشتری نیز خواهد شد (آین موارد قفل کوتاه مدت دارند و قابل انتقال به کاربر نمی باشند)
به همین دلیل خواهشمندم در صورت امکان دوستان تمام تلاش خود را برای حل این مشکل و مشکلهای عمومی دیگر گذاشته تا به جواب درستی برسیم، و جلو گیری نمائیم از نوشتن برنامه های بلند و ناکارآمد و بدون دانستن و استفاده از امکانات ذاتی خود برنامه.
متشکرم

[Sanaie]

با سلام
برای استفاده از تاریخ شمسی در اکسس کافی است که ویندوز شما تاریخ شمسی داشته باشد مثلا ویندوز 98 پارسا
آنگاه برنامه اکسس خود را باز کنید و چک باکس مسیر زیر را انتخاب فرمایید.
Tools- Startup - Advanced - HijriCalandar


موفق باشید .

[mahdie1]

حالا اگر در xp بودیم چطور پسر خوب

[rezaTavak]

ببینید شما مجبورید که تاریخ را به فرمت کاراکتری بگیرید. و پردازشها را هم خودتان کنترل کنید این مطمئن تر است. (این را تجربه کرده ام)

[mohammadgij]

ببینید شما مجبورید که تاریخ را به فرمت کاراکتری بگیرید. و پردازشها را هم خودتان کنترل کنید این مطمئن تر است. (این را تجربه کرده ام)

درسته.این بهترین راه حل ممکن هست که تاریخ رو حتی بدون "/" در جداول ذخیره کنید و پردازش اطلاعات رو خودمون کنترل کنیم.من سعی می کنم تا دو سه روز آینده از توی آرشیو کارام این تکه برنامه رو براتون بزارم و توضیحات مربوطه رو بدم.در ضمن این برنامه ای که من میگم دارای یه کلاس ماژول هست.


در ضمن در جواب این دوستمون که میخواست بدونه در Xp چی کار باید بکنه اگه خودتون تاریخ رو کنترل نمی کنید و نیاز دارید که از اکسس این امکان رو بخواهید باید برید به این قسمت
(از راست به چپ بخونید)

Use Hijri Calender ---- International ------Option

[منصور بزرگمهر]

من امتحان کردم عمل نکرد، و تاریخ هجری قمری شد. با اینکه در قسمت تنظیمات محلی ویندوز فارسی و تمام مورد ایران را انتخاب کردم، و در تنظیمات زبان آفیس 2002 XP نیز مورد فارسی را انتخاب کردم، ولی باز جواب نداده است.
شاید شما همانطور که گفته ام، ویندوز 98 پارسا و غیره دارید، که انها توکار زمان را شمسی کرده اند، و حال ما در XP به جواب نرسیده ایم.
البته شنیده ام در ویندوز لانگ هورن تابع تاریخ شمسی گنجانده شود(به همت چند تن از دوستان که نامشان را به یاد ندارم، ولی در یک سایت اقدام آنها و پذیرش آن از جناب میکروسافت را شنیدم، که جای تشکر و تقدیر از این دوستان را نیز دارم)
ولی به فرض مثال ما هم اکنون تاریخ کشور کره جنوبی (بعنوان مثال) را چگونه در کامپیوتر خود پیش گزیده کنیم، و چگونه از آن در برنامه نویسی و اکسس به شکل بالا گفته شده استفاده نمائیم، تا خود را بعد برای تاریخ شمسی آماده و مشکلات خود را رفع نمائیم.
در اخر این را باید بگویم، همین شرکتهای پارسا یا نوین و ... چگونه توابع ویندوز و بالطبع آن آفیس را شمسی کرده اند، که این همه برنامه نویس در این سایت هنوز راه حل مناسبی برای آن نیافته اند، و کلاً راه حل چیست؟

همان طور که می دانید، در اکسس در تکس باکسها راست کلیک نمائید، در زیر منو قسمتی بوجود می آید که می توانیم،‌ عملگر ها و .. که در دستور Where یک SQL شرایط تعیین کنیم، در اینجا فیلتر نمائیم، حال چنانچه ما در برنامه خود یک ستون تاریخ سر رسید چک داشته باشیم، عملگر های بزرگتر یا کوچکتر در مورد ستون های منی تاریخ عمل ننموده، و برای هر مورد تاریخ باید برنامه نویسی و مشکلات عدیده بکار ببریم.

در آخر از کلیه دوستانی که در پیگیری سئوال بنده همراهی نشان داده اند، تشکر می نمایم، و با اینکه برنامه خود را با تاریخ متنی شمسی نوشته و تمام کرده ام، ولی بشدت ناراحت و با مشکلات فراوانی روبرو بوده ام، که امیدورام دوستان روی این مشکل که فکر می کنم مشکل همگی باشد، بیشتر تامل نشان داده تا موضوع فوق حل گردد، و ما راه حل مناسب را داشته باشیم.

[mohammadgij]

سلام دوباره
این ماژول ذخیره کنید




'************************************************* ************************************

Option Compare Database
Public Function StringDate(OldDate As Double) As String
StringDate = Int(OldDate / 10000) & "/" & Int(OldDate / 100) - Int(OldDate / 10000) * 100 & "/" & OldDate - Int(OldDate / 100) * 100
End Function
Function SanadConvertDate() As String
Dim temp As Date
'******** Get date & Time From Server *********
Dim objcmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Set objcmd.ActiveConnection = CurrentProject.Connection
objcmd.CommandText = "ServerDate_sp"
objcmd.CommandType = adCmdStoredProc
Set rst = objcmd.Execute
Set objcmd = Nothing
If rst.BOF And rst.EOF Then
Else
Y = rst!Year
d = rst!Day
m = rst!Month


'************** Change To Shamsi Date**************
'******************* Leap year
If Y Mod 4 = 0 Then
If m > 2 Then
temp = DateSerial(Y, m, d)
temp = temp + 1
Y = Year(temp)
m = Month(temp)
d = Day(temp)
End If
End If
'*******************
If m < 3 Or (m = 3 And d < 21) Then
Y = Y - 622
Else
Y = Y - 621
End If
Select Case m
Case 1
If d < 21 Then
m = 10: d = d + 10
Else
m = 11: d = d - 20
End If
Case 2
If d < 20 Then
m = 11: d = d + 11
Else
m = 12: d = d - 19
End If
Case 3
If d < 21 Then
m = 12: d = d + 9
Else
m = 1: d = d - 20
End If
Case 4
If d < 21 Then
m = 1: d = d + 11
Else
m = 2: d = d - 20
End If
Case 5, 6
If d < 22 Then
m = m - 3: d = d + 10
Else
m = m - 2: d = d - 21
End If
Case 7, 8, 9
If d < 23 Then
m = m - 3: d = d + 9
Else
m = m - 2: d = d - 22
End If
Case 10
If d < 23 Then
m = 7: d = d + 8
Else
m = 8: d = d - 22
End If
Case 11, 12
If d < 22 Then
m = m - 3: d = d + 9
Else
m = m - 2: d = d - 21
End If
End Select
'************************************************* **
Dim ys As String: ys = Y
Dim ms As String: ms = m
If Len(ms) = 1 Then ms = "0" + ms
Dim DS As String: DS = d
If Len(DS) = 1 Then DS = "0" + DS
SanadConvertDate = ys & ms & DS
End If
End Function
Function SanadIsHijriDate(DDate As String) As String
Dim s As String
If DDate <> "" Then
s = DDate
If Left(s, 2) < 60 Then
MsgBox "áØÝÇð ÚÏÏ ÓÇá ÑÇ ÊÕÍíÍ ßäíÏ", vbInformation
SanadIsHijriDate = ""
Exit Function
End If
m = Mid(s, 3, 2)
If val(m) <= 0 Or val(m) > 12 Then
MsgBox "áØÝÇð ÚÏÏ ãÇå ÑÇ ÊÕÍíÍ ßäíÏ", vbInformation
SanadIsHijriDate = Left(DDate, 2)
Exit Function
End If
d = Right(s, 2)
' Debug.Print 7 <= val(m) < 12 And val(d) > 30
If (val(m) < 7 And val(d) > 31) Or ((val(m) >= 7 And val(m) < 12) And val(d) > 30) Or (val(m) = 12 And fnKabiseh("13" & Left(s, 4)) = 0 And val(d) > 29) Or (val(m) = 12 And fnKabiseh("13" & Left(s, 4)) = 0 And val(d) > 30) Or (val(d) < 1) Then
MsgBox "áØÝÇð ÚÏÏ ÑæÒ ÑÇ ÊÕÍíÍ ßäíÏ", vbInformation
SanadIsHijriDate = Left(DDate, 4)
Exit Function
End If
SanadIsHijriDate = s
End If
End Function
Function fnKabiseh(intDate) As Double
Dim intCounter As Integer
Dim intKabiseh As Integer
intKabiseh = 0
intCounter = 0
While intCounter <> 7
If intDate = 1375 + (4 * intCounter) Or intDate = 1370 - (4 * intCounter) Then
intKabiseh = 1
End If
intCounter = intCounter + 1
Wend
fnKabiseh = intKabiseh
End Function

'***********************************
این ماژول برای کار کسانی طراحی شده که بک اند اس کیو ال دارند و رویه SanadConvertDate کار تبدیل تاریخ میلادی به شمسی رو انجام میده که اگه شما با اس کیو ال کار نمی کنید خودتون میتونید این ماژول رو تغییر بدین

[منصور بزرگمهر]

دوست عزیز با تشکر از زحمات بیدریغ شما.

ولی هنوز چگونگی تغییر توکار تاریخ برنامه ها چه اکسس و چه Sql Server بیان نشده است.

روال فوق فقط تاریخ میلادی را به شمسی تبدیل میکند، که این تابع را دارم. ولی همانطور که در سئوال خود گفتم، تنها نمایش تاریخ در برنامه موضوع نمی باشد، بلکه استفاده از ستون تاریخ بعنوان پرس جو و در استفاده فیلتر اکسس (یا هر برنامه دیگر) مورد نظر می باشد، و باز ستون متنی که تاریخ ترجمه شده، از کد بالا در آن ذخیره شود، توانائی استفاده در پرس جوها و فیلتر ها نخواهد داشت، و نمی دانم، تا چقدر با ویندوز های پارسا 98 و ... کار کرده اید، آنها نتنها نمایش تاریخ ویندوز را شمسی کرده اند، بلکه لاقل برنامه های آفیس را نیز تاریخ توکار آنها را فارسی (هر چند باز غلط محاسباتی دارند) ولی همانند تاریخ میلادی می توان آنها در پرس جوها و فیلتر ها استفاده نمود، و همگی سر جای خود،‌ و هر عملگر و تابعی بر فرض در VB باشد (در مورد تابع تاریخ میلادی) در مورد این تاریخهای شمسی نیز درست عمل می کند، و مشکل همین جا می باشد، این برنامه ها چگونه توکار تاریخ ویندوز و آفیس را تغییر داده اند، که تاریخ بدرستی عمل کرده، و ...

ضمناً در روال بالا شما برای محاسبه کبیسه بودن سال میلادی سال مربوطه را بر 4 تقسیم و ... (قسمت Leap year ) که راه حل صحیح تر استفاده از پیشنهاد خود MSDN می باشد، که بدین گونه که در تاریخ میلادی ماه دوم آنها تعداد روزها 28 روز و در سال کبیسه 29 روز و با امتحان این موضوع که سال و ماه مربوطه 28 روزه می باشد، و یا 29 روزه کبیسه بودن سال مشخص و از روش فوق جل.گیری می شود، که اگر می دانید سالهای کبیسه نتنها هر 4 سال یکبار اتفاق می افتذ که مانده دقیقه و ثانیه آخر سال سبب می گردد که هر 32 سال یکبرا نیز سال کبیسه و هر حدوداً فکر می کنم 732 سال یکبار نیز ثانیه های مانده سبب سال کبیسه می گردند، که بدین گونه محاسبه دقیق سال کبیسه را به خود ویندوز و ... بسپارید.

بهر حال از جواب شما زحمات شما و سایر دوستان که در تلاش حل مشکل فوق کوشیده اند، متشکرم و امیدورام مشکل بزرگ فوق بطریقی حل گردد، که فکر می کنم، احتیاج اساسی جامعه ما خواهد بود.


متشکر - منصور بزرگمهر 1383/5/2 ساعت 2:49 بامداد

[MM_Mofidi]

دوسن عزیز اگر تسلط به برنامه نویسی c دارید در Sql به شما اجازه طراحی DLL فایل میدهد که در آن امکان طراحی نوح جدیدی از داده را دارید. اما به علت پیچیدگی و عدم اطمینان از نحوه کارکرد آن پیشنهاد میکنم از همان توابع نوشته شده استفاده کنید. بسیاری از این توابع امکاناتی نظیر محاسبه اختلاف دو روز ؛فاصله از اول سال؛روز هفته؛چکاپ صحت تاریخ و... را دارند و کار کردن با آنها هم ساده است و هم همه کنترل در اخنیار شماست.

[mohammadgij]

اگه اشتباه نکنم شما میخواهید که از این تاریخ در Query ها و Viewها استفاده کنید.درسته؟اگه اینطوره که شما میتونید این تاریخ رو همونطور که گفتم به صورت Nvarchar or Char Or Number ذخیره کنید و در Viewها یا Stored Procedureها از دستور <= , >= استفاده کنید.اما اینکه این تاریخ چگونه مانند ویندوز 98 در Queryها قابلیت استفاده داره رو من نمی دونم.چون خودم هم خیلی با ویندوز 98 کار کردم خصوصا پارسا و لی در اون ویندوز هم وقتی که مثلا در جستجویی می خواستم که از تاریخ استفاده کنم و امکان اینکه به حتما تاریخ در شرایط جستجو پر باشه نبود (یعنی نمی خواستم تاریخ رو به در Query به صورت ورودی بگیرم) بازم تاریخ شمسی جواب نمی داد و مجبور بودم که اول تاریخ رو میلادی کنم و بعدش ازش استفاده کنم.
بابت راهنماییت هم خیلی متشکرم
بای

[منصور بزرگمهر]

با عرض تشکر از دوست عزیزمان آقای mohammadgij

شما فرمودید از نوع داده Nvarchar or Char Or Number استفاده کنم. ابتدا این نوع داده یعنی چه و در کجای اکسس است. (البته می دانم نوع کارکتری در c است ولی بیشتر توضیح می خواستم )

ثانیاٌ در کجای اکسس این نوع داده وجود دارد و چگونه می توانم آنرا معرفی کنم (در SQL SERVER وجود دارد ولی در اکسس خیر)

ثالثاٌ شما می گوئید با دستورهای > یا < یا = و ... جواب می دهد(یعنی کوچکتر و بزرگتر تاریخ را جدا می کند) ولط آیا شما مطمئن هستید که این عمل را انجام می دهد، در حالی که فرمت تاریخ YYYY/MM/DD شمسی است و یا تعداد حروف را در قسمت تاریخ خلاصه کرده باشد نظیر ماه 08 بجای 8 خالی باز جواب می دهد و مشکلی ندارد.

در آخر شما گفته بودید در آفیس 97 همراه پارسا توابع تاریخ عمل نمی کنند. این را مطمئن می باشید. اینجانب تعداد زیادی از توابع را امتحان نکرده ام، ولی بعضی از آنها را امتحان و جواب درست گرفته ام. در مورد این موضوع نیز توضیح دهید .


متشکرم - منصور بزرگمهر 1383/5/28 - ساعت 4:39 بامداد

[hmm]

اگه lip مایکروسافت رو نصب کنید و دستور زیر رو انجام بدید تاریخ اکسس فارسی رو پشتبانی میکنه

(از راست به چپ بخونید)

Use Hijri Calender ---- International ------Option

[mohammadgij]

با عرض تشکر از دوست عزیزمان آقای mohammadgij

شما فرمودید از نوع داده Nvarchar or Char Or Number استفاده کنم. ابتدا این نوع داده یعنی چه و در کجای اکسس است. (البته می دانم نوع کارکتری در c است ولی بیشتر توضیح می خواستم )

ثانیاٌ در کجای اکسس این نوع داده وجود دارد و چگونه می توانم آنرا معرفی کنم (در SQL SERVER وجود دارد ولی در اکسس خیر)

ثالثاٌ شما می گوئید با دستورهای > یا < یا = و ... جواب می دهد(یعنی کوچکتر و بزرگتر تاریخ را جدا می کند) ولط آیا شما مطمئن هستید که این عمل را انجام می دهد، در حالی که فرمت تاریخ YYYY/MM/DD شمسی است و یا تعداد حروف را در قسمت تاریخ خلاصه کرده باشد نظیر ماه 08 بجای 8 خالی باز جواب می دهد و مشکلی ندارد.

در آخر شما گفته بودید در آفیس 97 همراه پارسا توابع تاریخ عمل نمی کنند. این را مطمئن می باشید. اینجانب تعداد زیادی از توابع را امتحان نکرده ام، ولی بعضی از آنها را امتحان و جواب درست گرفته ام. در مورد این موضوع نیز توضیح دهید .


سلام
من فکر کنم که اشتباهی مرتکب شدم.بله شما درست می فرمایید .این فرمت اکسس وجود نداره من چون خودم از اکسس و SQL استفاده می کنم این اشتباه رو مرتکب شدم.بهتره که از Text استفاده کنید
در مورد فرمت هم باید بکم که اگر میخواهید که از عملگر ها استفاده کنید باید روز و ماه که یک رقمی هست رو به یک صفر قبل از آن ذخیره کنید یعنی
13810101 درست است اما 138111 غلط است

در مورد این موضوع که توابع تاریخ در پارسا عمل نمی کنند منظور من برای ورودی به Query بود اونم وقتی که فیلد رو از نوع DateTime انتخاب کنیم. چون پارسا تاریخ رو شمسی به ما میده اما اگه به یه Query بخواین از بیرون تاریخ شمسی رو پاس بدین در صورتیکه فرمت فیلد شرط شما DateTime باشه حتما باید تاریخ رو به میلادی تبدیل کنید و بعد پاس بدین.اما اگه از فرمت Text استفاده می کنید و خودتون تاریخ رو تبدیل می کنید به شمسی ، درست عمل می کنه.
در پایان از اینکه اشتباه کردم و مطلب اشتباه گفتم معذرت می خوام

[منصور بزرگمهر]

دوست عزیز آقای/ خانم hmm با عرض سلام

در پاسخ خود فرمودید :

اگه lip مایکروسافت رو نصب کنید و دستور زیر رو انجام بدید تاریخ اکسس فارسی رو پشتبانی میکنه

و

Use Hijri Calender ---- International ------Option

خوب این برنامه lip را از کجا گیر بیاوریم توضیح دهید.

[hmm]

از سایت مایکروسافت

[mehrag]

تشکر از راهنماییهای دوستان در مورد تاریخ شمسی در اکسس من LIP رو نصب کردم و مسیر را که گفته بودید طی کردم تاریخ شمسی را اعمال کرد.
ممنون از همه.

[mhaeri]

سلام با تشکر از همگی.
یعنی با نصب LIP تمام مشکلات مربوط به تاریخ در اکسس حل شد؟
و توی XP دیگه مشکل ذخیره تاریخ و استفاده از توابع اون رو نداریم؟
اگر این باشه که :kiss: :kiss: :kiss:

[payam59]

من lip مایکروسافت رو هم نصب کردم ولی تاریخ قمری محاسبه می کنه!! :sad2: :sad2:

[payam59]

سری به وبلاگ : http://try.persianblog.com بزنید ماژول جالبی در مورد تاریخ شمسی داره

[منصور بزرگمهر]

با تشکر از دوستان

با نصب LIP قسمت Regional and Language Options چگونه باید تنظیم شده باشد تا تاریخ شمسی شود. چرا که در بعضی موارد دوستان بالا شمسی گردیده و در بعضی دیگر خیر لطفاً دوستانی که تاریخ انها شمسی شده است در قسمت فوق دقیقاً چه وضعیتی و چگونه تنظیم کرده اند.

[mhaeri]

سلام
با نصب LIP هم مشکل حل نمیشه
چون تاریخ شمسی در windows xp نداریم و تاریخ قمری محاسبه میشه
هنوز هم فارسی سازس مثل پارسا نیومده که توxp کار کنه.
کجایی برنا رایانه :(

[payam59]

شاید استفاده از ماژول زیر که تقریبا تمام تابعهای تاریخی رو داره مفید باشه (برای نمایش صحیح اگر بصورت ترکیبی استفاده بشه بایداز format استفاده کرد.)

منبع :http://try.persianblog.com

<span dir=ltr>
************************************************** ***********
' 1- تعریف کنید Number&#40;Long&#41; است را بصورت Date فیلدهایی که نوع آنها
' 2- این فیلدها را بصورت 00/00/00 تنظیم کنید InputMask خاصیت
' بدلیل 6 رقمی در نظر گرفتن فیلد تاریخ ، این توابع تا سال 1399 کارایی دارد
' ...
' تاریخ جاری سیستم را به هجری شمسی تبدیل می کند Shamsi&#40;&#41; تابع
' بکار ببرید Now&#40;&#41; را می توانید در گزارشات بجای تابع Dat&#40;&#41; تابع
' &#58;برای جلوگیری از ورود تاریخ غلط به درون یک فیلد بترتیب زیر عمل میکنید
' &#58;بشکل زیر بکار ببرید ValidationRule را در خاصیت ValidDate&#40;&#41; تابع
' ValidDate&#40;&#91;نام فیلد&#93;&#41;=True
' ...
' ************************************************** ***********

'*******************************************
' برنامه نویس &#58; حمید آزادی
' Email&#58; azadi1355@yahoo.com
' Web Address&#58; http&#58;//try.persianblog.com
' ویرایش سوم &#58; زمستان 1381
'*******************************************
Public Function Rooz&#40;F_Date As Long&#41; As Byte
'این تابع عدد مربوط به روز یک تاریخ را برمگرداند
Rooz = F_Date Mod 100
End Function
'*******************************************
Function Mah&#40;F_Date As Long&#41; As Byte
'این تابع عدد مربوط به ماه یک تاریخ را برمگرداند
Mah = Int&#40;&#40;F_Date Mod 10000&#41; / 100&#41;
End Function
'*******************************************
Public Function Sal&#40;F_Date As Long&#41; As Byte
'این تابع عدد مربوط به سال یک تاریخ را برمگرداند
Sal = Int&#40;F_Date / 10000&#41;
End Function
'*******************************************
Public Function Kabiseh&#40;ByVal OnlySal As Variant&#41; As Byte
'ورودی تابع عدد دورقمی است
'این تابع کبیسه بودن سال را برمیگرداند
'اگر سال کبیسه باشد عدد یک و درغیر اینصورت صفر را بر میگرداند
Kabiseh = 0
If OnlySal >= 75 Then
If &#40;OnlySal - 75&#41; Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
ElseIf OnlySal &lt;= 70 Then
If &#40;70 - OnlySal&#41; Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
End If

End Function
'*******************************************
Function ValidDate&#40;F_Date As Long&#41; As Boolean
Dim M, S, R As Byte
' این تابع اعتبار یک عدد ورودی را از نظر تاریخ هجری شمسی بررسی می کند
' را برمی گرداند False واگر نامعتبر باشد True اگر تاریخ معتبر باشد
ValidDate = True
S = Sal&#40;F_Date&#41;
M = Mah&#40;F_Date&#41;
R = Rooz&#40;F_Date&#41;
'********
If F_Date &lt; 100101 Then
ValidDate = False
Exit Function
End If

If M > 12 Or M = 0 Or R = 0 Then
ValidDate = False
Exit Function
End If

If R > MahDays&#40;S, M&#41; Then
ValidDate = False
Exit Function
End If
End Function
'*******************************************
Public Function AddDay&#40;ByVal F_Date As Long, ByVal add As Integer&#41; As Long
Dim K, M, S, R, Days As Byte
R = Rooz&#40;F_Date&#41;
M = Mah&#40;F_Date&#41;
S = Sal&#40;F_Date&#41;
K = Kabiseh&#40;S&#41;

'تبدیل روز به عدد 1 جهت ادامه محاسبات و یا اتمام محاسبه
Days = MahDays&#40;S, M&#41;
If add > Days - R Then
add = add - &#40;Days - R + 1&#41;
R = 1
If M &lt; 12 Then
M = M + 1
Else
M = 1
S = S + 1
End If
Else
R = R + add
add = 0
End If

While add > 0
K = Kabiseh&#40;S&#41; 'کبیسه&#58; 1 و غیر کبیسه&#58; 0
Days = MahDays&#40;S, M&#41; 'تعداد روزهای ماه فعلی
Select Case add
Case Is &lt; Days
'اگر تعداد روزهای افزودنی کمتر از یک ماه باشد
R = R + add
add = 0
Case Days To IIf&#40;K = 0, 365, 366&#41; - 1
'اگر تعداد روزهای افزودنی بیشتر از یک ماه و کمتر از یک سال باشد
add = add - Days
If M &lt; 12 Then
M = M + 1
Else
S = S + 1
M = 1
End If
Case Else
'اگر تعداد روزهای افزودنی بیشتر از یک سال باشد
S = S + 1
add = add - IIf&#40;K = 0, 365, 366&#41;
End Select
Wend
AddDay = &#40;S * 10000&#41; + &#40;M * 100&#41; + &#40;R&#41;

End Function

'***********************************************
Public Function Shamsi&#40;&#41; As Long
'تاریخ جاری سیستم را به تاریخ هجری شمسی تبدیل می کند
Dim Shamsi_Mabna As Long
Dim Miladi_mabna As Date
Dim Dif As Long
'در اینجا 80/10/11 با 2002/01/01 معادل قرارداده شده
Shamsi_Mabna = 791012
Miladi_mabna = #1/1/01#
Dif = DateDiff&#40;"d", Miladi_mabna, Date&#41;
If Dif &lt; 0 Then
MsgBox "تاریخ جاری سیستم شما نادرست است , آنرا اصلاح کنید."
Else
Shamsi = AddDay&#40;Shamsi_Mabna, Dif&#41;
End If
End Function
'***********************************************
Public Function DayWeek&#40;F_Date As Long&#41; As String
Dim a As String
Dim N As Byte
N = DayWeekNo&#40;F_Date&#41;
Select Case N
Case 0
a = "شنبه"
Case 1
a = "یکشنبه"
Case 2
a = "دوشنبه"
Case 3
a = "سه‌شنبه"
Case 4
a = "چهارشنبه"
Case 5
a = "پنج‌شنبه"
Case 6
a = "جمعه"
End Select
DayWeek = a
End Function

'***********************************************
Public Function Dat&#40;&#41;
Dim D As Long
D = Shamsi
Dat = DayWeek&#40;D&#41; &amp; " 13" &amp; Sal&#40;D&#41; &amp; "/" &amp; Mah&#40;D&#41; &amp; "/" &amp; Rooz&#40;D&#41;
End Function

'***********************************************
Public Function Diff&#40;ByVal FromDate As Long, ByVal To_Date As Long&#41; As Long
'این تابع تعداد روزهای بین دو تاریخ را ارائه می کند
Dim Tmp As Long
Dim S1, M1, r1, S2, m2, r2 As Integer
Dim Sumation As Single
Dim Flag As Boolean
Flag = False
If FromDate = 0 Or IsNull&#40;FromDate&#41; = True Or To_Date = 0 Or IsNull&#40;To_Date&#41; = True Then
Diff = 0
Exit Function
End If

If FromDate > To_Date Then
'اگر تاریخ شروع از تاریخ پایان بزرگتر باشد آنها موقتا جابجا می شوند
Flag = True
Tmp = FromDate
FromDate = To_Date
To_Date = Tmp
End If
r1 = Rooz&#40;FromDate&#41;
M1 = Mah&#40;FromDate&#41;
S1 = Sal&#40;FromDate&#41;
r2 = Rooz&#40;To_Date&#41;
m2 = Mah&#40;To_Date&#41;
S2 = Sal&#40;To_Date&#41;
Sumation = 0

Do While S1 &lt; S2 - 1 Or &#40;S1 = S2 - 1 And &#40;M1 &lt; m2 Or &#40;M1 = m2 And r1 &lt;= r2&#41;&#41;&#41;
'اگر یک سال یا بیشتر اختلاف بود
If Kabiseh&#40;&#40;S1&#41;&#41; = 1 Then
If M1 = 12 And r1 = 30 Then
Sumation = Sumation + 365
r1 = 29
Else
Sumation = Sumation + 366
End If
Else
Sumation = Sumation + 365
End If
S1 = S1 + 1
Loop

Do While S1 &lt; S2 Or M1 &lt; m2 - 1 Or &#40;M1 = m2 - 1 And r1 &lt; r2&#41;
'اگر یک ماه یا بیشتر اختلاف بود
Select Case M1
Case 1 To 6
If M1 = 6 And r1 = 31 Then
Sumation = Sumation + 30
r1 = 30
Else
Sumation = Sumation + 31
End If
M1 = M1 + 1
Case 7 To 11
If M1 = 11 And r1 = 30 And Kabiseh&#40;S1&#41; = 0 Then
Sumation = Sumation + 29
r1 = 29
Else
Sumation = Sumation + 30
End If
M1 = M1 + 1
Case 12
If Kabiseh&#40;S1&#41; = 1 Then
Sumation = Sumation + 30
Else
Sumation = Sumation + 29
End If
S1 = S1 + 1
M1 = 1
End Select
Loop

If M1 = m2 Then
Sumation = Sumation + &#40;r2 - r1&#41;
Else
Select Case M1
Case 1 To 6
Sumation = Sumation + &#40;31 - r1&#41; + r2
Case 7 To 11
Sumation = Sumation + &#40;30 - r1&#41; + r2
Case 12
If Kabiseh&#40;S1&#41; = 1 Then
Sumation = Sumation + &#40;30 - r1&#41; + r2
Else
Sumation = Sumation + &#40;29 - r1&#41; + r2
End If
End Select
End If

If Flag = True Then
Sumation = -Sumation
End If
Diff = Sumation
End Function

Public Function DayWeekNo&#40;F_Date As Long&#41; As String
'این تابع یک تاریخ را دریافت کرده و مشخص می کند چه روزی از هفته است
'اگر شنبه باشد عدد 0
'اگر 1شنبه باشد عدد 1
'......
'اگر جمعه باشد عدد 6
Dim day As String
Dim Shmsi_Mabna As Long
Dim Dif As Long
'مبنا 80/10/11
Shmsi_Mabna = 801011
Dif = Diff&#40;Shmsi_Mabna, F_Date&#41;
If Shmsi_Mabna > F_Date Then
Dif = -Dif
End If
'با توجه به اینکه 80/10/11 3شنبه است محاسبه میشود day متغیر
day = &#40;Dif + 3&#41; Mod 7
If day &lt; 0 Then
DayWeekNo = day + 7
Else
DayWeekNo = day
End If
End Function


Function MahName&#40;ByVal Mah_no As Byte&#41; As String
Select Case Mah_no
Case 1
MahName = "فروردین"
Case 2
MahName = "اردیبهشت"
Case 3
MahName = "خرداد"
Case 4
MahName = "تیر"
Case 5
MahName = "مرداد"
Case 6
MahName = "شهریور"
Case 7
MahName = "مهر"
Case 8
MahName = "آبان"
Case 9
MahName = "آذر"
Case 10
MahName = "دی"
Case 11
MahName = "بهمن"
Case 12
MahName = "اسفند"
End Select
End Function

Function SalMah&#40;ByVal F_Date As Long&#41; As Integer
'چهار رقم اول تاریخ که معرف سال و ماه است را برمی گرداند
SalMah = Val&#40;Left$&#40;F_Date, 4&#41;&#41;
End Function

Function MahDays&#40;ByVal Sal As Byte, ByVal Mah As Byte&#41; As Byte
'این تابع تعداد روزهای یک ماه را برمی گرداند
Select Case Mah
Case 1 To 6
MahDays = 31
Case 7 To 11
MahDays = 30
Case 12
If Kabiseh&#40;Sal&#41; = 1 Then
MahDays = 30
Else
MahDays = 29
End If
End Select

End Function

Function Make_Date&#40;ByVal F_Date As Long&#41; As String
'یک تاریخ را بصورت یک رشته 10 رقمی با ذکر چهار رقم برای سال ارائه می کند
Dim D As String
D = Trim&#40;Str&#40;F_Date&#41;&#41;
If IsNull&#40;F_Date&#41; = True Or F_Date = 0 Then
Make_Date = ""
Else
Make_Date = "13" &amp; Mid&#40;D, 1, 2&#41; &amp; "/" &amp; Mid&#40;D, 3, 2&#41; &amp; "/" &amp; Mid&#40;D, 5, 2&#41;
End If
End Function

Function NextMah&#40;ByVal Sal_Mah As Integer&#41; As Integer
If &#40;Sal_Mah Mod 100&#41; = 12 Then
NextMah = &#40;Int&#40;Sal_Mah / 100&#41; + 1&#41; * 100 + 1
Else
NextMah = Sal_Mah + 1
End If
End Function

Function PreviousMah&#40;ByVal Sal_Mah As Integer&#41; As Integer
If &#40;Sal_Mah Mod 100&#41; = 1 Then
PreviousMah = &#40;Int&#40;Sal_Mah / 100&#41; - 1&#41; * 100 + 12
Else
PreviousMah = Sal_Mah - 1
End If
End Function


Function SubtractDay&#40;ByVal F_Date As Long, ByVal Subtract As Long&#41; As Long
'به تعداد روز معینی از یک تاریخ کم کرده و تاریخ حاصله را ارائه میکند
Dim K, M, S, R, Days As Byte

R = Rooz&#40;F_Date&#41;
M = Mah&#40;F_Date&#41;
S = Sal&#40;F_Date&#41;
K = Kabiseh&#40;S&#41;

'تبدیل روز به عدد 1 جهت ادامه محاسبات و یا اتمام محاسبه
If Subtract >= R - 1 Then
Subtract = Subtract - &#40;R - 1&#41;
R = 1
Else
R = R - Subtract
Subtract = 0
End If

While Subtract > 0
K = Kabiseh&#40;S - 1&#41; 'کبیسه&#58; 1 و غیر کبیسه&#58; 0
Days = MahDays&#40;IIf&#40;M >= 2, S, S - 1&#41;, IIf&#40;M >= 2, M - 1, 12&#41;&#41; 'تعداد روزهای ماه قبلی
Select Case Subtract
Case Is &lt; Days
'اگر تعداد روزهای کاهش کمتر از یک ماه باشد
R = Days - Subtract + 1
Subtract = 0
If M >= 2 Then
M = M - 1
Else
S = S - 1
M = 12
End If
Case Days To IIf&#40;K = 0, 365, 366&#41; - 1
'اگر تعداد روزهای کاهش بیشتر از یک ماه و کمتر از یک سال باشد
Subtract = Subtract - Days
If M >= 2 Then
M = M - 1
Else
S = S - 1
M = 12
End If
Case Else
'اگر تعداد روزهای کاهش بیشتر از یک سال باشد
S = S - 1
Subtract = Subtract - IIf&#40;K = 0, 365, 366&#41;
End Select
Wend
SubtractDay = &#40;S * 10000&#41; + &#40;M * 100&#41; + &#40;R&#41;

End Function</span>

[sinapour]

سلام
ضمن تشکر از دوست عزیزم payam59 بابت ماژولی که گذاشتند اگر در قسمت وی بی بگردید ماژولهای مفید دیگری رو هم پبدا میکنید. البته به گستردگی این ماژول نیست .
راستی ایراد مهم این ماژول اینکه مجبور هستی تاریخ از راست به چپ واردکنی.

[سنبله کار]

سلام
من نمی دونستم که دوستان با این مشکل مواجه هستند .

شما می توانید با کپی فایل oleaut32.dll در شاخه windows\system32 چه در 2000 و چه در xp کلیه تاریخها را در access به فارسی ملاحظه کرده و در تمامی قسمتها از آن مثل تاریخ میلادی بهره بگیرید .

البته فراموش نشود که در tools\option\international باید گزینه use hijri calendar را تیک بزنید .
امیدوارم موفق باشید . :موفق:

[alahazrat81]

man ye majmooe office kharidam ke toosh az tavabe tarikhe shamsi estefade mishe yani ye filde date /time sakhtam bad short date ro entekhab kardam bad ham tooghesmate input mask gozine tarikhe shamsi ro entekhab kardam moshkel hal sho!!!!!!!!!!!!!!!

[alahazrat81]

man ziad majol nevisi balad nistam vase hamin kheili donbale in gashtam ghabl az oonam baraye fildhaye tarikh az number estefade mikardam bad too input mask raveshe khassi ro baraye vared kardanesh entekhab mikardam kheili khoooooob javab midad!

[alahazrat81]

man ziad majol nevisi balad nistam vase hamin kheili donbale in gashtam ghabl az oonam baraye fildhaye tarikh az number estefade mikardam bad too input mask raveshe khassi ro baraye vared kardanesh entekhab mikardam kheili khoooooob javab midad!

[daskar]

یه سری اینجا بزن نحوه فارسی کردن تاریخ در اکسس
http://barnamenevis.org/forum/showthread.php?t=85747

[javad490]

لطفا به اینجا سری بزنید:
http://barnamenevis.org/forum/showthread.php?t=89633&highlight=%D8%AA%D8%A7%D8%B1%DB%8C%D8%AE+%D8%B4%D9 %85%D8%B3%DB%8C

[dearabi]

سلام دوباره
این ماژول ذخیره کنید




'************************************************* ************************************

Option Compare Database
Public Function StringDate&#40;OldDate As Double&#41; As String
StringDate = Int&#40;OldDate / 10000&#41; &amp; &quot;/&quot; &amp; Int&#40;OldDate / 100&#41; - Int&#40;OldDate / 10000&#41; * 100 &amp; &quot;/&quot; &amp; OldDate - Int&#40;OldDate / 100&#41; * 100
End Function
Function SanadConvertDate&#40;&#41; As String
Dim temp As Date
'******** Get date &amp; Time From Server *********
Dim objcmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Set objcmd.ActiveConnection = CurrentProject.Connection
objcmd.CommandText = &quot;ServerDate_sp&quot;
objcmd.CommandType = adCmdStoredProc
Set rst = objcmd.Execute
Set objcmd = Nothing
If rst.BOF And rst.EOF Then
Else
Y = rst!Year
d = rst!Day
m = rst!Month


'************** Change To Shamsi Date**************
'******************* Leap year
If Y Mod 4 = 0 Then
If m > 2 Then
temp = DateSerial&#40;Y, m, d&#41;
temp = temp + 1
Y = Year&#40;temp&#41;
m = Month&#40;temp&#41;
d = Day&#40;temp&#41;
End If
End If
'*******************
If m &lt; 3 Or &#40;m = 3 And d &lt; 21&#41; Then
Y = Y - 622
Else
Y = Y - 621
End If
Select Case m
Case 1
If d &lt; 21 Then
m = 10&#58; d = d + 10
Else
m = 11&#58; d = d - 20
End If
Case 2
If d &lt; 20 Then
m = 11&#58; d = d + 11
Else
m = 12&#58; d = d - 19
End If
Case 3
If d &lt; 21 Then
m = 12&#58; d = d + 9
Else
m = 1&#58; d = d - 20
End If
Case 4
If d &lt; 21 Then
m = 1&#58; d = d + 11
Else
m = 2&#58; d = d - 20
End If
Case 5, 6
If d &lt; 22 Then
m = m - 3&#58; d = d + 10
Else
m = m - 2&#58; d = d - 21
End If
Case 7, 8, 9
If d &lt; 23 Then
m = m - 3&#58; d = d + 9
Else
m = m - 2&#58; d = d - 22
End If
Case 10
If d &lt; 23 Then
m = 7&#58; d = d + 8
Else
m = 8&#58; d = d - 22
End If
Case 11, 12
If d &lt; 22 Then
m = m - 3&#58; d = d + 9
Else
m = m - 2&#58; d = d - 21
End If
End Select
'************************************************* **
Dim ys As String&#58; ys = Y
Dim ms As String&#58; ms = m
If Len&#40;ms&#41; = 1 Then ms = &quot;0&quot; + ms
Dim DS As String&#58; DS = d
If Len&#40;DS&#41; = 1 Then DS = &quot;0&quot; + DS
SanadConvertDate = ys &amp; ms &amp; DS
End If
End Function
Function SanadIsHijriDate&#40;DDate As String&#41; As String
Dim s As String
If DDate &lt;> &quot;&quot; Then
s = DDate
If Left&#40;s, 2&#41; &lt; 60 Then
MsgBox &quot;&amp;aacute;&amp;Oslash;&amp;Yacute;&amp;Ccedil;&amp;eth; &amp;Uacute;&amp;Iuml;&amp;Iuml; &amp;Oacute;&amp;Ccedil;&amp;aacute; &amp;Ntilde;&amp;Ccedil; &amp;Ecirc;&amp;Otilde;&amp;Iacute;&amp;iacute;&amp;Iacute; &amp;szlig;&amp;auml;&amp;iacute;&amp;Iuml;&quot;, vbInformation
SanadIsHijriDate = &quot;&quot;
Exit Function
End If
m = Mid&#40;s, 3, 2&#41;
If val&#40;m&#41; &lt;= 0 Or val&#40;m&#41; > 12 Then
MsgBox &quot;&amp;aacute;&amp;Oslash;&amp;Yacute;&amp;Ccedil;&amp;eth; &amp;Uacute;&amp;Iuml;&amp;Iuml; &amp;atilde;&amp;Ccedil;&amp;aring; &amp;Ntilde;&amp;Ccedil; &amp;Ecirc;&amp;Otilde;&amp;Iacute;&amp;iacute;&amp;Iacute; &amp;szlig;&amp;auml;&amp;iacute;&amp;Iuml;&quot;, vbInformation
SanadIsHijriDate = Left&#40;DDate, 2&#41;
Exit Function
End If
d = Right&#40;s, 2&#41;
' Debug.Print 7 &lt;= val&#40;m&#41; &lt; 12 And val&#40;d&#41; > 30
If &#40;val&#40;m&#41; &lt; 7 And val&#40;d&#41; > 31&#41; Or &#40;&#40;val&#40;m&#41; >= 7 And val&#40;m&#41; &lt; 12&#41; And val&#40;d&#41; > 30&#41; Or &#40;val&#40;m&#41; = 12 And fnKabiseh&#40;&quot;13&quot; &amp; Left&#40;s, 4&#41;&#41; = 0 And val&#40;d&#41; > 29&#41; Or &#40;val&#40;m&#41; = 12 And fnKabiseh&#40;&quot;13&quot; &amp; Left&#40;s, 4&#41;&#41; = 0 And val&#40;d&#41; > 30&#41; Or &#40;val&#40;d&#41; &lt; 1&#41; Then
MsgBox &quot;&amp;aacute;&amp;Oslash;&amp;Yacute;&amp;Ccedil;&amp;eth; &amp;Uacute;&amp;Iuml;&amp;Iuml; &amp;Ntilde;&amp;aelig;&amp;Ograve; &amp;Ntilde;&amp;Ccedil; &amp;Ecirc;&amp;Otilde;&amp;Iacute;&amp;iacute;&amp;Iacute; &amp;szlig;&amp;auml;&amp;iacute;&amp;Iuml;&quot;, vbInformation
SanadIsHijriDate = Left&#40;DDate, 4&#41;
Exit Function
End If
SanadIsHijriDate = s
End If
End Function
Function fnKabiseh&#40;intDate&#41; As Double
Dim intCounter As Integer
Dim intKabiseh As Integer
intKabiseh = 0
intCounter = 0
While intCounter &lt;> 7
If intDate = 1375 + &#40;4 * intCounter&#41; Or intDate = 1370 - &#40;4 * intCounter&#41; Then
intKabiseh = 1
End If
intCounter = intCounter + 1
Wend
fnKabiseh = intKabiseh
End Function

'***********************************
این ماژول برای کار کسانی طراحی شده که بک اند اس کیو ال دارند و رویه SanadConvertDate کار تبدیل تاریخ میلادی به شمسی رو انجام میده که اگه شما با اس کیو ال کار نمی کنید خودتون میتونید این ماژول رو تغییر بدین

سلام ممنون از زحماتتون میشه بگید که من اینو کجا و چگونه ذخیره کنم

[mina01]

سلام دوست عزیز
با استفاده از برنامه ای که تاریخها را تبدیل به تاریخ شمسی می کند می توانید براحتی تاریخهای میلادی را تبدیل به شمسی نموده و حتی اختلاف دو تاریخ را برحسب روز و ماه و ساعت بدست آورید و در صورت وارد نمودن اشتباه تاریخها با نوشتن کد خطا خواهد گرفت
در صورت تمایل ایمیلتان را برام بفرستین تا فایل رو براتون میل کنم

[mohammadsaleh]

با سلام

البته خود من از ماژول هاي مخلتفي در برنامه استفاده كردم . ولي اگر دوستان حرفه اي با ايجاد يك فايل setup و نشر آن در سايت جهت استفاده دوست اين كار رو به سرانجام مي رساندند خيلي خوب بود .يعني در كنار برنامه با نصب آن فايل تاريخ كامپيوتر هم از تاريخ شمسي پشتيبان داشته باشد.

با تشكر