# پایگاه‌های داده > سایر پایگاه‌های داده > Access > آموزش: ماژول کامل تاریخ شمسی در اکسس با VBA

## Rasool-GH

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

به عنوان مقدمه ای در تکمیل مبحث به مواردی باید اشاره بشه . 
به طور کلی محاسبات مربوط به تاریخ شمسی در محیط اکسس به دلیل اینکه از این نوع تاریخ پشتیبانی نمیکنه به دو روش قابل انجام و دست یابی است .
 اولین روش استفاده از یک ماژول تو کار VBA میباشد که توابع مورد نیاز در اون گرد اوری شده باشه و از این توابع به فراخور نیاز در جاهای مختلف برنامه استفاده میشه 
مزایا : استفاده از این روش راحته . کدها در دسترس هستند . بررسی و اصلاح و تکمیل اون به راحتی امکان پذیره
معایب : امکان ایجاد تغییرات سهوی در ماژول وجود داره . به دلیل افزایش کدهای داخل برنامه فایل اکسس را در معرض خطر تخریب قرار میده
دومین روش استفاده از یک فایل DLL هست که باز هم همین توابع در داخل اون گرد اوری شده و در جاهای مختلف برنامه قابل استفاده است 
مزایا : در این روش فایل به راحتی قابل دستکاری نیست و توابع داخل اون در معرض تخریب قرار نمیگیرن 
معایب : برای استفاده نیاز به اضافه کردن در رفرنس اکسس داره . فایلهای کامل معمولا پولی هستند . دسترسی به کدهای اونها وجود نداره

اساتید لطفا در تکمیل و تصحیح توضیحات بالا نظرات خودشون رو بدن . 


ماژولها و برنامه های مشابه :



> /==========================/
> 
> *ماژول Persian Function 
> راهنمای ماژول  قسمت 1 
> راهنمای ماژول قسمت 2 
> 
> یک نمونه ماژول کاری از جناب امیری 
> 
> یک نمونه OCX کاری از جناب پیروزمهر* *
> ...




نمونه ای از تمام فایلهای موجود در تاپیک در ضمیمه امده است ولیکن از اخرین ورژن استفاده کنید . ورژن های قبلی صرفا جهت بررسی کدها و تغییرات توسط علاقه مندان قرار گرفته است
تنها مورد که باید ذکر بشه Input mask هست که حتما باید به صورت -;0;0000/00/00 باشه

----------


## Rasool-GH

سلام 
دوستان برای به دست اوردن تاریخ روز از تابع زیر در Default Value باکس مورد نظر خودتون استفاده کنید . 
Shamsi() 
این تابع تاریخ رو بدون "/" ذخیره میکنه . برای اینکه به همراه / ذخیره بشه از تابع زیر  استفاده کنید .
 Slash(Shamsi())
برای سنجش اعتبار تاریخ میتونید از تابع زیر استفاده کنید .
ValidDate([Field Name])=True 
 برای اشاره به خود کنترل بدون ذکر نام اون از تابع به شکل زیر استفاده کنید
ValidDate(Screen.ActiveControl)=True 
(البته داخل قسمت Validation Rule کنترل مورد نظر)

برای بدست اوردن تفاوت زمان بین دو تاریخ میتونید از این کد استفاده کنید 
Diff(Date1,Date2)

----------


## Rasool-GH

دوستان عزیز نمونه جدید اماده شد 
از این نمونه میتونید در اضافه کردن و کم کردن و تفاضل تاریخ استفاده کنید 
نمونه کاملا گویاست . تنها مورد که باید ذکر بشه Input mask هست که حتما باید به صورت  -;0;00/00/00"13"  باشه
ضمنا اکثر موارد خطا ها هم حذف شده و با خیال راحت میتونید استفاده کنید

----------


## expert2219

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

----------


## mj_bayati

> تنها مورد که باید ذکر بشه Input mask هست که حتما باید به صورت  -;0;00/00/"13"  باشه


البته فک میکنم این نکته در مورد ماژول استفاده شده درست نباشه
اون ماسکی که شما فرمودین برای ماژول اصلی آقای آزادی است ولی این ماژول استفاده شده ماژول اصلاحی است و خودش سال رو 4 رقمی حساب می کنه، بنابراین نیازی به گذاشتن "13" در ابتدا سال نیست
بلکه ماسک مناسب همون 0000/00/00 است

اگه اشتباه میکنم اساتید تذکر بدن

----------


## Rasool-GH

کاملا صحیح هستش . منظور عدد 13 نبود به دلیل روال کنترل خطایی که استفاده شده باید -;0; در اخر ماسک بیاد .
-;0;0000/00/00
دارم روش کار میکنم درست شد همینجا قرار میدم 
اساتید لطفا راهنمایی کنن و از انتقادات خودشون مارو بی نصیب نزارن

----------


## Abbas Amiri

بدلیل اینکه خود تابع دارای تابع اعتبارسنجی است بهتر است InputMask فیلد به 9999/99/99 تغییر کند تا پیغام Validation فیلد در زمان ناقص تایپ کردن نمایش داده نشود

----------


## mj_bayati

> بدلیل اینکه خود تابع دارای تابع اعتبارسنجی است بهتر است InputMask فیلد به 9999/99/99 تغییر کند


خیلی حرف زیبا و جالبی زده شد...
باتشکر از استاد امیری

آقای *Rasool-GH* لطفاً توجه فرمایید....

----------


## mosafer1375

آیا حتما باید فیلدی که برای تاریخ توی جدول تعریف میکنیم حتما از نوع عدد باشه
یعنی اگه تکست باشه جواب نمیده 
چون من توی توابع تاریخی که باید وارد کنم وقتی فیلد مربوطه رو بصورت عدد (number) می زارم ارور می ده و وقتی یتکت میکنم درست میشه
در این مورد هم راهنمایی کنید ممنون میشم

----------


## Abbas Amiri

اگر تابعی فقط آرگومان عددی می پذیرد وشما نوع تکست دارید می توانید از توابع تبدیل نوع استفاده کنید مثل (CInt(str و (CLng(str

----------


## Rasool-GH

سلام 
با توجه به اينكه در كوئري ها شما براي مقايسه تاريخها نياز دارين كه تيپ همه تاريخها به يك شكل باشه مجبور هستين كه در ماسك از 0 استفاده كنيد . در غير اين صورت تاريخهايي كه به شكل (1390/10/1) (1390/2/1) تايپ شده در گزارشگيري باعث اشتباه ميشه در صورتي كه اگر به صورت (1390/02/01) باشه ديگه اين اشتباه پيش نمياد . دارم روي تابع كار ميكنم كه تاريخ (1390/1/1) رو به صورت (1390/01/01) ذخيره كنه . در اين زمينه هركي ميتونه كمك منه. 
ممنون از توجه دوستان

----------


## Rasool-GH

> آیا حتما باید فیلدی که برای تاریخ توی جدول تعریف میکنیم حتما از نوع عدد باشه


خدمت شما عرض كنم كه اگر فيلد رو عدد تعيين ميكنيد از خود توابع استفاده كنيدShamsi()     تاريخ روز را به صورت 13900205 بازميگرداند  در صورتي كه نياز داريد تاريخها با / ذخيره بشه نوع فيلد رو تكست تعيين كنيد و توابع رو داخل تابع Slash قرار بدينSlash(Shamsi())     تاريخ روز را به صورت 1390/02/05 بازميگرداند

----------


## mosafer1375

> خدمت شما عرض كنم كه اگر فيلد رو عدد تعيين ميكنيد از خود توابع استفاده كنيدShamsi()     تاريخ روز را به صورت 13900205 بازميگرداند  در صورتي كه نياز داريد تاريخها با / ذخيره بشه نوع فيلد رو تكست تعيين كنيد و توابع رو داخل تابع Slash قرار بدينSlash(Shamsi())     تاريخ روز را به صورت 1390/02/05 بازميگرداند



من بالاخره تونستم با خصوصیت number از این تابع استفاده کنم
البته از این تابع
shansi()
ولی این تابع هر کاری میکنم نمی تونم استفاده کنم چراش رو نمیدونم وقتی خصوصیت رو به تکست تبدیل می کنم درست میشه
slash(shamsi())

کاربری توی همین بخش یه نمونه گذاشته بودن که با کلیک بروی کلیدی می تونستی از تقویمی که ظاهر می شد تاریخ رو انتخاب کرد این نمونه هم برای من به هیچ وجه از فیلدی با خصوصیت number اجرا نمیشد که مجبور شدم به تکست تبدیل کنم که این تبدیل توی  جستجوی  بین دو تاریخ مشکل بوجود می اورد لازم به ذکره که این نمونه نیز از همین ماژول های موجود در همین بخش استفاده ککرده یعنی ماژول ادیت شده آقای ازادی
راهنمایی کنید

----------


## Rasool-GH

اگر بیشتر توجه کنید توضیح کامل داده شده تابع اول خروجی عددی داره یعنی فیلد میتونه Number باشه 
در تابع دوم به دلیل وجود / خروجی رشته است یعنی داخل فیلد Number قابل ذخیره سازی نیست و حتما باید فیلد رو به تکست تبدیل کنید

----------


## Abbas Amiri

استفاده از این تابع برای تکمیل تاریخهای ناکامل مثل 139011 که منظور 13900101 می باشد ویا 1390221 ویا ... می تواند مورد استفاده قرار گیرد دوستان تست کنند تا اگر اشکالی بود  متفقا مرتفع کنیم. اگر خروجی صفر باشد تاریخ نامعتبر خواهد بود

Public Function FixUncompeleteDate(ByVal fDate As Long) As Long
    Dim date1 As String, date2 As Long
    date1 = CStr(fDate)
    If Len(date1) < 6 Then
        Exit Function
    End If
    date2 = CLng(Left(date1, 4))
    If Len(date1) = 6 Then
        date2 = CLng(date2 & 0 & Mid(date1, 5, 1) & 0 & Right(date1, 1))
    ElseIf Len(date1) = 7 Then
        If Right(date1, 1) > 3 Then
            date2 = CLng(date2 & Mid(date1, 5, 2) & Right(date1, 2))
        ElseIf Mid(date1, 6, 1) > 3 Then
            date2 = CLng(date2 & Mid(date1, 5, 2) & 0 & Right(date1, 1))
        ElseIf Mid(date1, 5, 1) > 1 Or Right(date1, 1) = 0 Then
            date2 = CLng(date2 & 0 & Mid(date1, 5, 1) & Right(date1, 2))
        Else
            date2 = CLng(date2 & Mid(date1, 5, 2) & 0 & Right(date1, 1))
        End If
    End If
    If ValidDate(date2) = False Then Exit Function
    FixUncompeleteDate = date2
End Function

----------


## emami.sie

> سلام 
> با توجه به اينكه در كوئري ها شما براي مقايسه تاريخها نياز دارين كه تيپ همه تاريخها به يك شكل باشه مجبور هستين كه در ماسك از 0 استفاده كنيد . در غير اين صورت تاريخهايي كه به شكل (1390/10/1) (1390/2/1) تايپ شده در گزارشگيري باعث اشتباه ميشه در صورتي كه اگر به صورت (1390/02/01) باشه ديگه اين اشتباه پيش نمياد . دارم روي تابع كار ميكنم كه تاريخ (1390/1/1) رو به صورت (1390/01/01) ذخيره كنه . در اين زمينه هركي ميتونه كمك منه.


با سلام
خدمت دوستان عرض کنم که به نظر من اصلا نیازی به وجود صفر در Mask نیست و شما می تونید از همون ماسک"13"99/99/99;0 استفاده کنید، بخاطر اینکه شما دارید از تابع اعتبار سنجی تاریخ استفاده می کنید و خود تابع تاریخ ناکامل رو تشخیص و پیغام میده...
در مورد تابعی هم که جناب امیری برای تکمیل تاریخ پیشنهاد دادند باید بگم تابع جالبیه، اما مشکل داره و فکر نکنم به نتیجه برسه چون وقتی شما مثلا تاریخ 1390112 رو وارد می کنید چه جوری میشه تشخیص داد که منظور کاربر 1390/11/2 بوده یا 1390/1/12 ... 
قبلا از اینکه در محضر اساتید ارائه نظر کردم عذر خواهی میکنم...
یا علی

----------


## abdoreza57

با سلام 

ضمن تشکر بابت زحمتی که کشیده اید  مورد بعدی تو بدست آوردن اختلاف ایام هست که قاعدتا عدد متناظر وجود نداره عمل نخواهد کرد 
در ضمن به اعتقاد من این داستان خیلی دنباله دار شده ضمن اینکه تمام این مانورها با وجود تابع کامل پرشین تولز کلا مرتفع میگردد چه التحابی برای استفاده مختص از تابع آزادی است ؟

----------


## emami.sie

> با سلام 
> 
> ضمن تشکر بابت زحمتی که کشیده اید  مورد بعدی تو بدست آوردن اختلاف ایام هست که قاعدتا عدد متناظر وجود نداره عمل نخواهد کرد 
> در ضمن به اعتقاد من این داستان خیلی دنباله دار شده ضمن اینکه تمام این مانورها با وجود تابع کامل پرشین تولز کلا مرتفع میگردد چه التحابی برای استفاده مختص از تابع آزادی است ؟


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

----------


## Rasool-GH

من اين تابع رو نديده بودم . برسي كردم خيلي جالب بود با توجه به امكاناتي كه داخلش هست براي موارد زيادي ميشه ازش استفاده كرد .
 تابع اقاي ازادي يه دليل سادگي در ويرايش و استفاده خيلي خوبه مخصوصا براي دوستاني كه بخوان وارد برنامه نويسي بشن از جنبه اموزشي خيلي كار امده 
ولي در كل با اين تابعي كه شما معرفي كردين خيلي جامع هست 



> استفاده از این تابع برای تکمیل تاریخهای ناکامل مثل 139011 که منظور 13900101 می باشد ویا 1390221 ویا ...


اين كدي كه اقاي اميري زحمت كشيدن قرار دادن رو  داخل ماژول قرار ميدم تا همه در قالب همين ماژول بتونن استفاده كنن . با تشكر از جناب اميري

----------


## mosafer1375

آیا من اگه بخوام از تابع 
slash(shamsi())
استفاده کنم که از نوع تکست هست بعدا مشکلی توی سرچ بین دو تاریخ برام بوجود نمیاد؟
ممنون میشم یه نمونه برام بزارید

----------


## Rasool-GH

سلام 
من متاسفم که چنین برداشتی به وجود امده . 
من در تاپیک قبلی که شما اشاره کردین با این ماژول مشکل داشتم . به لطف Zero Defect عزیر مشکل با نمونه کدی که ایشون زحمت کشیدن و اصلاح کردن حل شد 
من هم دیدم کلی بحث روی این موضوع در تالار وجود داره که هر کدوم یک قسمت ناقص داره . برای همین کل ماژول رو مطابق کدی که Zero Defect  عزیز اصلاح کرده بودن اصلاح کردم وبرای استفاده عمومی با اموزش نحوه استفاده در این تاپیک قرار دادم و در او تاپیک قبلی هم ادرس دادم که هر کی به این مطلب نیاز داشت بتونه به یک ماژول سالم به همراه اموزش استفاده از اون دسترسی داشته باشه . 
ادعایی برای ارائه مطلب جدیدی نداشتم و ندارم . 
اون موردی هم که ذکر کردین ویرایش شده مربوط به 


> دوستان عزيز لطفا اينجا سوال نپرسين كه اين تاپيك فقط جنبه اموزشي داشته باشه. سوالات رو *اينجا* مطرح كنيد


 نبود بلکه منظور ویرایش فایلی بود که پیوست شده بود 
به هر حال از مدیر تالار درخواست دارم در صورت صلاحدید این مطالب رو به تاپیک قبلی منتقل کنن و فقط پستهای اموزش ماژول اینجا باقی بمونه 
ممنون از توجه همه دوستان

----------


## Abbas Amiri

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

Public Function Miladi(ByVal ShamsiDate)
Dim DiffYear As Integer
Dim DiffMonth As Integer
Dim fYear As Integer, fMonth As Integer, fDay As Integer
Dim Days As Double, fd As Long
fd = CLng(Replace(ShamsiDate, "/", ""))
j = Len(CStr(fd))
If j = 6 Then
    fd = 13000000 + fd
End If
If j <> 8 Or Not ValidDate(fd) Then
    Miladi = Null
    Exit Function
End If
fYear = IL(fd)
fMonth = ay(fd)
fDay = Guon(fd)
DiffYear = fYear - 1343
DiffMonth = fMonth - 1
Select Case DiffMonth
    Case Is < 6
       Days = DiffMonth * 31 + fDay
    Case 6 To 11
        Days = (DiffMonth - 6) * 30 + fDay + 186
End Select
Days = Days + Int(DiffYear * 365.243) - 1
Miladi = DateAdd("d", CLng(Days), "1964/03/21")
End Function

----------


## mas_nejat

> با سلام 
> 
> ضمن تشکر بابت زحمتی که کشیده اید  مورد بعدی تو بدست آوردن اختلاف ایام هست که قاعدتا عدد متناظر وجود نداره عمل نخواهد کرد 
> در ضمن به اعتقاد من این داستان خیلی دنباله دار شده ضمن اینکه تمام این مانورها با وجود تابع کامل پرشین تولز کلا مرتفع میگردد چه التحابی برای استفاده مختص از تابع آزادی است ؟


سلام
یک مورد راهنمایی می خواستم
در Table در Acceess 2010 می خواهم فیلدی درست کنم که خودش تاریخ و روز و ساعت شمسی را نشان دهد و پس از ذخیره در دیتابیس قرار گیرد. وقتی از این ماِژول ها استفاده می کنم در Design Table مقدار Default Value را برابر =J_Today() قرار می دهم پیغام خطا می دهد . چنانچه امکانش هست راهنمایی بفرمایید.

----------


## hamid-nice

> دوستان عزیز نمونه جدید اماده شد 
> از این نمونه میتونید در اضافه کردن و کم کردن و تفاضل تاریخ استفاده کنید 
> ضمنا اکثر موارد خطا ها هم حذف شده و با خیال راحت میتونید استفاده کنید


 با سلام 
1-خوب است که تغییرات ماژول اصلاحی همراه با تغییر در نحوه بکارگیری هر تغییر را که آقای رسولی زحمتش را کشیدید نسبت به ماژول اصلاح شده جناب آزادي توسط احمد ميرزازاده به تاريخ 1388/7/22 (که در فایل ضمیمه زیر در یک ماژول قرار داده شده ) لیست شود و اگر چیزی اضافه کرده اند یا اشکالی را برطرف نموده اند عنوان شود تا قضیه منسجم تر و جمع بندی و نتیجه گیری بهتری و مشخص تری از این ماژول پرکاربرد صورت گیرد (منظورم نسبت به ماژول زیر است که تا قبل از ماژول اصلاحی آقای رسولی فکر کنم آخرین اصلاحیه بوده) و اگر هم بعد از ماژول آقای رسولی کسی اصلاحیه ای داده لطفا آنرا ارائه نمایید تا معلوم شود آخرین اصلاحیه این ماژول به کجا رسیده است
2- استفاده از Farsidatepicker که در ضمیمه آورده شده و با ماژول اصلاح شده زیر هماهنگ هست هم به دلیل تغییر توابع در ماژول آصلاح شده جناب رسولی نیز باید اصلاح شود تا به درستی عمل کند که اگر دوستان زحمت این تغییر را با مآژول اصلاح شده جدید بکشند و تغییرات لازم را انجام دهند ممنون می شیم
لینکی که فایل ضمیمه در آن هست :
https://barnamenevis.org/showthread.p...l=1#post827848
هر یک از دوستان هم که بتونن این لیست را ارائه دهند ممنون می شیم
با تشکر[LTR]

----------


## hamid-nice

کسی تمایل به انجام مورد بالا ندارد ؟

----------


## mahmood3d

یه سؤال از اساتید محترم دارم
تا حدودی با این ماژول کارم راه افتاد ولی یه مشکلی دارم و اینکه میخوام یک کوری بنویسم که اطلاعات بین دو تاریخ رو بهم نشون بده. اینجا که فیلد تاریخ از نوع Text هست چطوری میتونم یه همچین کوری بنویسم؟؟؟ مثلا داده های بین 92/02/01 تا 92/05/24 رو واکشی کنم.

----------


## Abbas Amiri

> یه سؤال از اساتید محترم دارم
> تا حدودی با این ماژول کارم راه افتاد ولی یه مشکلی دارم و اینکه میخوام یک کوری بنویسم که اطلاعات بین دو تاریخ رو بهم نشون بده. اینجا که فیلد تاریخ از نوع Text هست چطوری میتونم یه همچین کوری بنویسم؟؟؟ مثلا داده های بین 92/02/01 تا 92/05/24 رو واکشی کنم.


برای اینکه تاریخ از نوع تکست را بصورت نامبر درآورید از تابع Replace استفاده کنید
d1=CLng(Replace(Date1,"/",""))

----------


## abdoreza57

سلام

با توجه به پیشنهاد دوستمون hamid_nice و  اینکه استاد امیری تو تاپیکی مجزا *آموزش تقویم قابل ویرایش* را ایجاد نمودند که متاسفانه علی رقم اهمیت و کاربردی بودن این مسئله نتوانست مخاطبان خود را جذب کند البته این از دید من بود شاید به دلیل جذابیت فوق العاده اکتیوکسهای PDC باشه که خیلی ها را مثل من از افتادن تو دام کدنویسی های پیچیده بی نیاز میکنه ....

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


اگه بخواییم از پیچیدگی های کد نویسی فرار کنیم نمونه زیر خوب هست ولی من نتونستم مناسبتها را با فرمول dlookup فرا خوانی کنم 
مشکل کجا هست ؟
ضمنا اگه جناب امیری راهکاری برای سادگی این تقویم دارند یا تغییراتی تو نمونه خودشون دادند و میدونند کاربردی هست لطف کنند و بازم مثل همیشه راهنمای ما باشند که عزت و طول عمرشون آرزوی همه خواهد بود

خدا نگهدار

----------


## mahmood3d

آقای امیری تو جواب پست قبلی من که داده بودین اون کد داده متنی تاریخ من رو تبدیل به عدد می کنه و به من میده. من از این داده عددی چطوری برای هدفم استفاده کنم؟؟ من داده های یک بازه تاریخی رو میخوام.
درواقع چیزی که توی دیتابیس من ذخیره شده یک داده متنی هست و چیزی که این تابع به من میده یک داده عددیه. چطوری میتونم از این داده یک بازه تولید کنم و تو دیتابیس استفاده کنم؟؟

----------


## Abbas Amiri

> آقای امیری تو جواب پست قبلی من که داده بودین اون کد داده متنی تاریخ من رو تبدیل به عدد می کنه و به من میده. من از این داده عددی چطوری برای هدفم استفاده کنم؟؟ من داده های یک بازه تاریخی رو میخوام.
> درواقع چیزی که توی دیتابیس من ذخیره شده یک داده متنی هست و چیزی که این تابع به من میده یک داده عددیه. چطوری میتونم از این داده یک بازه تولید کنم و تو دیتابیس استفاده کنم؟؟


ابتدا متغیرهای تاریخ عددی را به تکست تبدیل و سپس عبارت شرط را ایجاد کنید(فرض شده نام فیلد تاریخ شما  MyDate است) 


Dim Date1  As String, Date2 As String
' d1,d2=Numeric Date
Date1 = Format(d1,"####/##/##")
Date2 = Format(d2,"####/##/##")

strCriteria = "MyDate >= '" & Date1 & "' AND MyDate <= '" & Date2 & "'"

----------


## Abbas Amiri

> سلام
> 
> با توجه به پیشنهاد دوستمون hamid_nice و  اینکه استاد امیری تو تاپیکی مجزا *آموزش تقویم قابل ویرایش* را ایجاد نمودند که متاسفانه علی رقم اهمیت و کاربردی بودن این مسئله نتوانست مخاطبان خود را جذب کند البته این از دید من بود شاید به دلیل جذابیت فوق العاده اکتیوکسهای PDC باشه که خیلی ها را مثل من از افتادن تو دام کدنویسی های پیچیده بی نیاز میکنه ....
> 
> امروز اتفاقی وقتی این تاپیک بالا اومد یاد تقویم استاد امیری افتادم که واقعا چه پروژه ای را دست گرفتند و نمیدونم به کجا رسید ؟ 
> تو اون نمونه به نظر من چون از مازولهای متعددی استفاده شده بود نتونست همه گیر بشه ولی واقعا از اهمیت کارشون ذره ای کم نمیکنه .
> 
> 
> اگه بخواییم از پیچیدگی های کد نویسی فرار کنیم نمونه زیر خوب هست ولی من نتونستم مناسبتها را با فرمول dlookup فرا خوانی کنم 
> ...


مناسبتها رو به شکل زیر و در انتهای روال optCalendar_Click درج کنید


Me.Txtrooz = DLookup("[rooz]", "taghvim", "[dateday]='" & STRDATE & "'")


در ضمن باکمی تغییر ، روزهای تعطیل را هم میتوان به رنگ قرمز نمایش داد

----------


## mahmood3d

آقا حله دست شما درد نکنه  :چشمک: 
من فکر کردم چون داده رشته ایه جواب نمیده ولی جواب داد. مرسی

----------


## abdoreza57

سلام



> مناسبتها رو به شکل زیر و در انتهای روال optCalendar_Click درج کنید
> 
> 
> Me.Txtrooz = DLookup("[rooz]", "taghvim", "[dateday]='" & STRDATE & "'")
> 
> 
> در ضمن باکمی تغییر ، روزهای تعطیل را هم میتوان به رنگ قرمز نمایش داد



ممنونم از لطفتون اون مورد به کمک شما حل شد .

پیشنهاد خوبی دادید لذا من فیلد Tatil را به Yes/No تغییر دادم که  رنگ روزهای انتخابی را بشه تغییر داد 
انواع دستورهای من درآوردی را توش بکار بردم خطا میگیره !

اگه لطف کنید و خودتون بفرمایید منت دارتون خواهم بود 

خدا نگهدار

----------


## Abbas Amiri

> سلام
> 
> 
> 
> ممنونم از لطفتون اون مورد به کمک شما حل شد .
> 
> پیشنهاد خوبی دادید لذا من فیلد Tatil را به Yes/No تغییر دادم که  رنگ روزهای انتخابی را بشه تغییر داد 
> انواع دستورهای من درآوردی را توش بکار بردم خطا میگیره !
> 
> ...


فایلی اصلی رو پیدا نکردم ولی این یکی هم جواب شما را خواهد داد:

----------


## mr_jafari2001

برای دیده شدن بصورت صحیح متنهای فارسی داخل فرمها و ماژولهای این فایلها در Windows 7 و Access 2007 چه تنظیماتی وجود دارد؟

----------


## mohammad5593

باسلام خدمت همه اساتید
چرا از این استفاده نمی کنید.
http://npmpro.blogfa.com/post/3/%D8%...B9%DA%A9%D8%B3
من در همه برنامه هام استفاده کردم بدون نقص و خیلی عالی کار میکنه
اینم سایت اصلی 
http://cpsd.ir/?

----------


## abdoreza57

> فایلی اصلی رو پیدا نکردم ولی این یکی هم جواب شما را خواهد داد:



سلام

فایل ارسالیتون همان طور که عرض کردم حرف نداره میمونه یک نکته :
امکان تبدیل به date picker درش هست یا اینکه چه تغییری تو  optCalendar_Click باید داد تا به نتیجه رسید؟

خدا نگهدار

----------


## Abbas Amiri

> باسلام خدمت همه اساتید
> چرا از این استفاده نمی کنید.
> http://npmpro.blogfa.com/post/3/%D8%...B9%DA%A9%D8%B3
> من در همه برنامه هام استفاده کردم بدون نقص و خیلی عالی کار میکنه
> اینم سایت اصلی 
> http://cpsd.ir/?


مسلما یکی از بهترین اکتیو ایکسها برای تاریخ شمسی فایل مورد اشاره شماست .
ولی اینجا سایت برنامه نویس است و خیلی ها بدنبال مهارت ویا بی نیازی به اکتیوایکس و ... هستند. برای همین در موارد مشابه بحث و ارائه نظر بسیار است .

----------


## Abbas Amiri

> برای دیده شدن بصورت صحیح متنهای فارسی داخل فرمها و ماژولهای این فایلها در Windows 7 و Access 2007 چه تنظیماتی وجود دارد؟


هرچند برنامه فوق یک کار تجاری نیست ولی مشکل شما در استفاده از آن چیست؟

----------


## mr_jafari2001

> هرچند برنامه فوق یک کار تجاری نیست ولی مشکل شما در استفاده از آن چیست؟


 
مشکل من در نمایش فارسی کامنتها و تکستهای فرمها بود که از change system locale در Regional Language و تغییر آن به persian حل شد.

----------


## aimaz23

یه سوال ازاین ماژول ها چطوری میشه در تیبل استفاده کرد یا فقط در کوئری ریپورت فرم قابل استفاده هستند
ممنون میشم راهنمایی کنید

----------


## ictman64

سلام من تازه کارم ببخشید می تونم بپرسم چطوری میتونم از ماژول های شما عزیزان در برنامه خودم استفاده کنم فعلا در خد ساخت فرم و جدول هستم 2 روزه کار عملی شروع کردم

----------


## sepehr_sepehr

سلام به همه دوستان
میشه بگید چه جوری باید از این ماژول استفاده کرد؟ 
من می خوام جدولم یه فیلدش از نوع تاریخ شمسی باشه
ممنون

----------


## Rasool-GH

دوستان در جهت تکمیل توضیحات پست اول و دوم اظهار نظر کنید لطفا

----------


## Rasool-GH

سلام دوستان . نسخه جدید ماژول با افزوده شدن یک تابع برای محاسبه تفاضل تاریخ به سال و ماه و روز

----------


## Rasool-GH

سلام 
این نسخه تازه تکمیل شده و یک سری تغییرات رو اعمال کردم که امکان داره با نسخه های قبلی در بعضی موارد و نام توابع همخوانی نداشته باشه 
ضمنا توابع مربوط به محاسبه چندمین روز سال و نام روز و ماه هم اصلاح و اضافه شده

----------


## noorionline

آقا رسول عزیز متشکرم از زحماتتون. فقط من میخوام بدونم ماسک 0000/00/00 با ماسکی که پیشنهاد شده یعنی -,0000/00/0,0 چه تفاوتی داره؟
البته ماسک رو وقتی میذاریم به این شکل تبدیل میشه:
\-,0000/00/0,0
در واقع شیوه نمایش تاریخ به این صورته:
-,1404/02/2,4

----------


## Nazir Ahmad

> آقا رسول عزیز متشکرم از زحماتتون. فقط من میخوام بدونم ماسک 0000/00/00 با ماسکی که پیشنهاد شده یعنی -,0000/00/0,0 چه تفاوتی داره؟
> البته ماسک رو وقتی میذاریم به این شکل تبدیل میشه:
> \-,0000/00/0,0
> در واقع شیوه نمایش تاریخ به این صورته:
> -,1404/02/2,4


سلام دوست عزیز.
ماسک رو به این صورت وارد کن
0000/00/00;0;-
نتیجه اینطوری میشه 
1395/02/25

یاحق

----------


## malek37m

بینهایت سپاسگزارم

----------


## 5hahin

آقا کارت خیلی درسته خیلی ممنونم ازت که همچین چیزی رو گذاشتی ملت استفاده کنن مرسی انشالله که 50 در دنیا صد در آخرت نصیبت بشه

----------


## Mehr@ban

سلام

دوتا مطلب

اول اینکه این ماژول ارزشمند که توسط آقا رسول عزیز تجمیع و منتشر شد، آپدیت نشده و یا دیگر دوستان بروز رسانی برای این ماژول ندادن؟
دوم اینکه اگر بخوام محدوده بین دو تاریخ شمسی رو بدست بیارم که اکثرا برای تهیه گزارش کاربرد داره رو بدست بیارم چطور هست؟ همون دستور Between

----------


## amirzazadeh

سلام از تابع Diff ماژول استفاده كنيد:
Public Function Diff(ByVal FromDate As Long, ByVal To_Date As Long) 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(FromDate) = True Or To_Date = 0 Or IsNull(To_Date) = 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(FromDate)
M1 = Mah(FromDate)
S1 = sal(FromDate)
r2 = Rooz(To_Date)
M2 = Mah(To_Date)
S2 = sal(To_Date)
Sumation = 0

Do While S1 < S2 - 1 Or (S1 = S2 - 1 And (M1 < M2 Or (M1 = M2 And r1 <= r2)))
'ÇÑ íß ÓÇá íÇ ÈíÔÊÑ ÇÎÊáÇÝ ÈæÏ
If Kabiseh((S1)) = 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 < S2 Or M1 < M2 - 1 Or (M1 = M2 - 1 And r1 < r2)
'ÇÑ íß ãÇå íÇ ÈíÔÊÑ ÇÎÊáÇÝ ÈæÏ
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(S1) = 0 Then
Sumation = Sumation + 29
r1 = 29
Else
Sumation = Sumation + 30
End If
M1 = M1 + 1
Case 12
If Kabiseh(S1) = 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 + (r2 - r1)
Else
Select Case M1
Case 1 To 6
Sumation = Sumation + (31 - r1) + r2
Case 7 To 11
Sumation = Sumation + (30 - r1) + r2
Case 12
If Kabiseh(S1) = 1 Then
Sumation = Sumation + (30 - r1) + r2
Else
Sumation = Sumation + (29 - r1) + r2
End If
End Select
End If

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

----------


## Mehr@ban

من هر کاری کردم نشد
میشه این نمونه رو یه بازبینی بکنید؟

----------


## amirzazadeh

سلام
نمونه شما تغيير دادم ببينيد مشكل برطرف شده.

----------


## Mehr@ban

> سلام
> نمونه شما تغيير دادم ببينيد مشكل برطرف شده.


تشکر
پس دستور like با دستور between قابل ادغام نیست مستقیما؟
ضمن اینکه بعد از انجام دستورفیلتر سازی، با کلیک بر روی دکمه حذف فیلتر، سابفرم کلا خالی میشه و داده ای رو نشون نمیده!

در مورد بازه زمانی برای ساعت هم به همین نحو نوشته میشه؟

----------


## amirzazadeh

سلام
با دستور like قابل اجرا هست ولي چون يكي از جداول برنامه اپلود نشده بود خطا ميداد.اگه نمونه شامل جداول مرتبط اپلود بشه بهتر ميشه جواب داد.

----------


## Mehr@ban

ممنونم بابت پیگیری
ولی جدول مرتبط با این فرم همین یکی هست که در ضمیمه موجوده
یعنی هم فیلدهای فرم و هم سابفرم به یک جدول مرتبط هست
جدول دومی نیست

----------


## eb_343

> سلام
> 
> دوتا مطلب
> 
> اول اینکه این ماژول ارزشمند که توسط آقا رسول عزیز تجمیع و منتشر شد، آپدیت نشده و یا دیگر دوستان بروز رسانی برای این ماژول ندادن؟
> دوم اینکه اگر بخوام محدوده بین دو تاریخ شمسی رو بدست بیارم که اکثرا برای تهیه گزارش کاربرد داره رو بدست بیارم چطور هست؟ همون دستور Between


سلام !
نیازی به استفاده از تابع ماژول تاریخ شمسی نیست ، در همون نمونه اولیه خودت برای فیلتر کردن از از کد های زیر استفاده کن !

Me.frm_sublogs.Form.Filter = "log_EventDate >= '" & txtStartDate & "' and log_EventDate <= '" & txtEndDate & "'"
Me.frm_sublogs.Form.FilterOn = True
Me.frm_sublogs.Requery


ضمناً نام سابفرم را خلاصه تر کن ، من آن را به  frm_sublogs  تغییر دادم 

برای حذف فیلتر هم  Me.frm_sublogs.Form.Filter را مساوی "" قرار بده  
یا علی

----------


## jigar2000

واسه چی همه ضمیمه ها فقط حاوی فرم هستش و جدول نداره پس اطلاعات به چه روشی در جدول ذخیره بشه

----------


## saeedhz67

خیلی خوب بود واقعا ممنونم

----------


## hosain937

با سلام به همه استادان عزیز من از یک ماژول شمسی در یک برنامه استفاده کردم ولی متاسفانه از اول دسامبر دیگه کار نمی کنه چرا لطفا از دوستان راهنمایی بفرمایید قبلا سپاسگزارم

----------


## hosain937

با سلام به اساتید محترم
من در یک برنامه از ماژول تاریخ شمسی استفاده کردم ولی متاسفانه از اول سپتامبر دیگه جواب نمی ده و با باز کردن برنامه پیغام خطای  Run-time error '6':over flow رو میده مشکل کجاست ممنون

----------


## amirzazadeh

> با سلام به اساتید محترم
> من در یک برنامه از ماژول تاریخ شمسی استفاده کردم ولی متاسفانه از اول سپتامبر دیگه جواب نمی ده و با باز کردن برنامه پیغام خطای  Run-time error '6':over flow رو میده مشکل کجاست ممنون


لطفا نمونه كارتون رو اپلود كنيد.

----------


## hosain937

Option Compare Database
'Çíä ãÊÛííÑ ãÞÏÇÑ ßáíß ÔÏå ÏÑ ÝÑã ÊÞæíã Ñæ ÈÕæÑÊ ÓÑÇÓÑí ÏÑ ÎæÏÔ ÐÎíÑå ãíßäå
Public STRDATE As String
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\  \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'                            Ç'   ãÇŽæá ÇÕáÇÍ ÔÏå ÌäÇÈ ÂÒÇÏí ÊæÓØ ÑÓæá ÛáÇãí Èå ÊÇÑíÎ 1390/10/15
'                       1- ÊÚÑíÝ ßäíÏ Number(Long) ÇÓÊ ÑÇ ÈÕæÑÊ Date Ç'   ÝíáÏåÇíí ßå äæÚ ÂäåÇ
'                            2- Çíä ÝíáÏåÇ ÑÇ ÈÕæÑÊ 0000/00/00 ÊäÙíã ßäíÏ InputMask Ç'   ÎÇÕíÊ
'                Ç'   ÈÏáíá 8 ÑÞãí ÏÑ äÙÑ ÑÝÊä ÝíáÏ ÊÇÑíÎ ¡ Çíä ÊæÇÈÚ ÊÇ ÓÇá 9999 ßÇÑÇíí ÏÇÑÏ
'                             ÊÇÑíÎ ÌÇÑí ÓíÓÊã ÑÇ Èå åÌÑí ÔãÓí ÊÈÏíá ãí ßäÏ Shamsi() Ç'   ÊÇÈÚ
'                           ÈßÇÑ ÈÈÑíÏ Now() ÑÇ ãí ÊæÇäíÏ ÏÑ ÒÇÑÔÇÊ ÈÌÇí ÊÇÈÚ Dat() Ç'   ÊÇÈÚ
'             Èå ßÇÑ ÈÈÑíÏ / ÑÇ ãíÊæÇäíÏ ÌåÊ ÏÑÌ ÊÇÑíÎ ÏÑ ÌÏÇæá Èå åãÑÇå ShamsiDat() Ç'   ÊÇÈÚ
'                    Ç'   ÈÑÇí ÌáæíÑí ÇÒ æÑæÏ ÊÇÑíÎ ÛáØ Èå ÏÑæä íß ÝíáÏ ÈÊÑÊíÈ ÒíÑ Úãá ãíßäíÏ
'   ÝíáÏ ãæÑÏ äÙÑ ÈßÇÑ ÈÈÑíÏ ValidationRule ÑÇ ÏÑ ÎÇÕíÊ ValidDate([Field Name])=True Ç'   ÊÇÈÚ
'/////////////////////////////////////////////////////////////////////////////////////////////


Public Static Function Shamsi() As Long
'Çíä ÊÇÈÚ ÊÇÑíÎ ÌÇÑí ÓíÓÊã ÑÇ Èå ÊÇÑíÎ åÌÑí ÔãÓí ÊÈÏíá ãí ßäÏ
Dim Shamsi_Mabna As Long
Dim Miladi_mabna As Date
Dim Dif As Long
'ÏÑ ÇíäÌÇ 78/10/11 ÈÇ 2000/01/01 ãÚÇÏá ÞÑÇÑÏÇÏå ÔÏå
Shamsi_Mabna = 13781011
Miladi_mabna = #1/1/2000#
Dif = DateDiff("d", Miladi_mabna, Date)
If Dif < 0 Then
MsgBox "ÊÇÑíÎ ÌÇÑí ÓíÓÊã ÔãÇ äÇÏÑÓÊ ÇÓÊ , ÂäÑÇ ÇÕáÇÍ ßäíÏ."
Else
Shamsi = AddDay(Shamsi_Mabna, Dif)
End If
End Function


Public Function dat() As String
' ÈßÇÑ ÈÈÑíÏ Now() ÑÇ ãí ÊæÇäíÏ ÏÑ ÒÇÑÔÇÊ ÈÌÇí ÊÇÈÚ Dat() ÊÇÈÚ
dat = DayWeek(Shamsi) & " - " & Slash(Shamsi)
End Function


Public Function Slash(F_Date As Variant) As String
' Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ æ ÈÕæÑÊ íß ÑÔÊå 10 ÑÞãí ÔÇãá / æ åÇÑ ÑÞã ÈÑÇí ÓÇá ÈÇÒãíÑÏÇäÏ
F_Date = Replace(F_Date, "/", "")
Dim a As Long
a = CLng(F_Date)
Slash = Format(IL(a), "0000") & "/" & Format(ay(a), "00") & "/" & Format(Guon(a), "00")
End Function


Function ValidDate(F_Date As Variant) As Boolean
' Çíä ÊÇÈÚ ÇÚÊÈÇÑ íß ÚÏÏ æÑæÏí ÑÇ ÇÒ äÙÑ ÊÇÑíÎ åÌÑí ÔãÓí ÈÑÑÓí ãí ßäÏ
' ÑÇ ÈÑãí ÑÏÇäÏ False æÇÑ äÇãÚÊÈÑ ÈÇÔÏ True ÇÑ ÊÇÑíÎ ãÚÊÈÑ ÈÇÔÏ
On Error GoTo Err_ValidDate
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim M, s, R As Byte
F_Date = Replace(F_Date, "/", "")
R = Guon(CLng(F_Date))
M = ay(CLng(F_Date))
s = IL(CLng(F_Date))
If F_Date < 10000101 Then Exit Function
If M > 12 Or M = 0 Or R = 0 Then Exit Function
If R > ayDays(s, M) Then Exit Function
ValidDate = True


Exit_ValidDate:
    On Error Resume Next
    Exit Function
Err_ValidDate:
    Select Case err.Number
        Case 0
            Resume Exit_ValidDate:
        Case 94
            ValidDate = True
        Case Else
            MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function ValidDate"
            Resume Exit_ValidDate:
    End Select
End Function


Public Function AddDay(ByVal F_Date As Variant, ByVal add As Long) As Long
'Çíä ÊÇÈÚ ÊÚÏÇÏ ÑæÒ ÏáÎæÇå ÑÇ Èå ÊÇÑíÎ ÑæÒ ÇÖÇÝå ãíßäÏ
On Error GoTo Err_AddDay
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
F_Date = Replace(F_Date, "/", "")
Dim K, M, R, Days As Byte
Dim s As Integer
R = Guon(CLng(F_Date))
M = ay(CLng(F_Date))
s = IL(CLng(F_Date))
K = Kabiseh(s)
'ÊÈÏíá ÑæÒ Èå ÚÏÏ 1 ÌåÊ ÇÏÇãå ãÍÇÓÈÇÊ æ íÇ ÇÊãÇã ãÍÇÓÈå
Days = ayDays(s, M)
If add > Days - R Then
add = add - (Days - R + 1)
R = 1
If M < 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(s) 'ßÈíÓå: 1 æ ÛíÑ ßÈíÓå: 0
Days = ayDays(s, M) 'ÊÚÏÇÏ ÑæÒåÇí ãÇå ÝÚáí
Select Case add
Case Is < Days
'ÇÑ ÊÚÏÇÏ ÑæÒåÇí ÇÝÒæÏäí ßãÊÑ ÇÒ íß ãÇå ÈÇÔÏ
R = R + add
add = 0
Case Days To IIf(K = 0, 365, 366) - 1
'ÇÑ ÊÚÏÇÏ ÑæÒåÇí ÇÝÒæÏäí ÈíÔÊÑ ÇÒ íß ãÇå æ ßãÊÑ ÇÒ íß ÓÇá ÈÇÔÏ
add = add - Days
If M < 12 Then
M = M + 1
Else
s = s + 1
M = 1
End If
Case Else
'ÇÑ ÊÚÏÇÏ ÑæÒåÇí ÇÝÒæÏäí ÈíÔÊÑ ÇÒ íß ÓÇá ÈÇÔÏ
s = s + 1
add = add - IIf(K = 0, 365, 366)
End Select
Wend
AddDay = CLng(s & Format(M, "00") & Format(R, "00"))


Exit_AddDay:
    On Error Resume Next
    Exit Function
Err_AddDay:
    Select Case err.Number
        Case 0
            Resume Exit_AddDay:
        Case 94
            AddDay = 0
        Case Else
            MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function AddDay"
            Resume Exit_AddDay:
    End Select
End Function


Function SubDay(ByVal F_Date As Variant, ByVal Subtract As Long) As Long
'Èå ÊÚÏÇÏ ÑæÒ ãÚíäí ÇÒ íß ÊÇÑíÎ ßã ßÑÏå æ ÊÇÑíÎ ÍÇÕáå ÑÇ ÇÑÇÆå ãíßäÏ
On Error GoTo Err_SubDay
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
F_Date = Replace(F_Date, "/", "")
Dim K, M, s, R, Days As Byte
R = Guon(CLng(F_Date))
M = ay((CLng(F_Date)))
s = IL((CLng(F_Date)))
K = Kabiseh(s)
'ÊÈÏíá ÑæÒ Èå ÚÏÏ 1 ÌåÊ ÇÏÇãå ãÍÇÓÈÇÊ æ íÇ ÇÊãÇã ãÍÇÓÈå
If Subtract >= R - 1 Then
Subtract = Subtract - (R - 1)
R = 1
Else
R = R - Subtract
Subtract = 0
End If
While Subtract > 0
K = Kabiseh(s - 1) 'ßÈíÓå: 1 æ ÛíÑ ßÈíÓå: 0
Days = ayDays(IIf(M >= 2, s, s - 1), IIf(M >= 2, M - 1, 12)) 'ÊÚÏÇÏ ÑæÒåÇí ãÇå ÞÈáí
Select Case Subtract
Case Is < 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(K = 0, 365, 366) - 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(K = 0, 365, 366)
End Select
Wend
SubDay = (s * 10000) + (M * 100) + (R)


Exit_SubDay:
    On Error Resume Next
    Exit Function
Err_SubDay:
    Select Case err.Number
        Case 0
            Resume Exit_SubDay:
        Case 94
            SubDay = 0
        Case Else
            MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function SubDay"
            Resume Exit_SubDay:
    End Select
End Function


Public Function DayWeekNo(F_Date As Variant) As Byte
'Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ ßÑÏå æ ÔãÇÑå ÑæÒ åÝÊå ÑÇ ãÔÎÕ ãí ßäÏ
'ÇÑ ÔäÈå ÈÇÔÏ ÚÏÏ 0
'ÇÑ 1ÔäÈå ÈÇÔÏ ÚÏÏ 1
'......
'ÇÑ ÌãÚå ÈÇÔÏ ÚÏÏ 6
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
F_Date = Replace(F_Date, "/", "")
Dim day As String
Dim Shmsi_Mabna As Long
Dim Dif As Long
'ãÈäÇ 80/10/11
Shmsi_Mabna = 13801011
Dif = Diff(Shmsi_Mabna, CLng(F_Date))
If Shmsi_Mabna > CLng(F_Date) Then
Dif = -Dif
End If
'ÈÇ ÊæÌå Èå Çíäßå 80/10/11 3ÔäÈå ÇÓÊ ãÍÇÓÈå ãíÔæÏ day ãÊÛíÑ
day = (Dif + 3) Mod 7
If day < 0 Then
DayWeekNo = day + 7
Else
DayWeekNo = day
End If
End Function


Public Function DayWeek(F_Date As Variant) As String
'Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ ßÑÏå æ ãÔÎÕ ãí ßäÏ å ÑæÒí ÇÒ åÝÊå ÇÓÊ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim a As String
Dim n As Byte
n = DayWeekNo(F_Date)
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 Diff(ByVal date1 As Variant, ByVal Date2 As Variant) As Long
'Çíä ÊÇÈÚ ÊÚÏÇÏ ÑæÒåÇí Èíä Ïæ ÊÇÑíÎ ÑÇ ÇÑÇÆå ãí ßäÏ
On Error GoTo Err_Diff
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
date1 = Replace(date1, "/", "")
Date2 = Replace(Date2, "/", "")
Dim tmp As Long
Dim S1, M1, R1, S2, M2, R2 As Integer
Dim Sumation As Single
Dim Flag As Boolean
Flag = False
If CLng(date1) = 0 Or IsNull(CLng(date1)) = True Or CLng(Date2) = 0 Or IsNull(CLng(Date2)) = True Then
Diff = 0
Exit Function
End If
'ÇÑ ÊÇÑíÎ ÔÑæÚ ÇÒ ÊÇÑíÎ ÇíÇä ÈÒÑÊÑ ÈÇÔÏ ÂäåÇ ãæÞÊÇ ÌÇÈÌÇ ãí ÔæäÏ
If CLng(date1) > CLng(Date2) Then
Flag = True
tmp = CLng(date1)
date1 = CLng(Date2)
Date2 = tmp
End If
R1 = Guon(CLng(date1))
M1 = ay(CLng(date1))
S1 = IL(CLng(date1))
R2 = Guon(CLng(Date2))
M2 = ay(CLng(Date2))
S2 = IL(CLng(Date2))
Sumation = 0
Do While S1 < S2 - 1 Or (S1 = S2 - 1 And (M1 < M2 Or (M1 = M2 And R1 <= R2)))
'ÇÑ íß ÓÇá íÇ ÈíÔÊÑ ÇÎÊáÇÝ ÈæÏ
If Kabiseh((S1)) = 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 < S2 Or M1 < M2 - 1 Or (M1 = M2 - 1 And R1 < R2)
'ÇÑ íß ãÇå íÇ ÈíÔÊÑ ÇÎÊáÇÝ ÈæÏ
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(S1) = 0 Then
Sumation = Sumation + 29
R1 = 29
Else
Sumation = Sumation + 30
End If
M1 = M1 + 1
Case 12
If Kabiseh(S1) = 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 + (R2 - R1)
Else
Select Case M1
Case 1 To 6
Sumation = Sumation + (31 - R1) + R2
Case 7 To 11
Sumation = Sumation + (30 - R1) + R2
Case 12
If Kabiseh(S1) = 1 Then
Sumation = Sumation + (30 - R1) + R2
Else
Sumation = Sumation + (29 - R1) + R2
End If
End Select
End If
If Flag = True Then
Sumation = -Sumation
End If
Diff = Sumation


Exit_Diff:
    On Error Resume Next
    Exit Function
Err_Diff:
    Select Case err.Number
        Case 0
            Resume Exit_Diff:
        Case 94
            Diff = 0
        Case Else
            MsgBox err.Number & " " & err.Description, vbExclamation, "Error in module Module2 - function Diff"
            Resume Exit_Diff:
    End Select
End Function


Function ayName(ByVal ay_no As Byte) As String
'Çíä ÊÇÈÚ íß ÊÇÑíÎ ÑÇ ÏÑíÇÝÊ ßÑÏå æ ãÔÎÕ ãí ßäÏ å ãÇåí ÇÒ ÓÇá ÇÓÊ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Select Case ay_no
Case 1
ayName = "ÝÑæÑÏíä"
Case 2
ayName = "ÇÑÏíÈåÔÊ"
Case 3
ayName = "ÎÑÏÇÏ"
Case 4
ayName = "ÊíÑ"
Case 5
ayName = "ãÑÏÇÏ"
Case 6
ayName = "ÔåÑíæÑ"
Case 7
ayName = "ãåÑ"
Case 8
ayName = "ÂÈÇä"
Case 9
ayName = "ÂÐÑ"
Case 10
ayName = "Ïí"
Case 11
ayName = "Èåãä"
Case 12
ayName = "ÇÓÝäÏ"
End Select
End Function


Function ayDays(ByVal IL As Integer, ByVal ay As Byte) As Byte
'Çíä ÊÇÈÚ ÊÚÏÇÏ ÑæÒåÇí íß ãÇå ÑÇ ÈÑãí ÑÏÇäÏ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Select Case ay
Case 1 To 6
ayDays = 31
Case 7 To 11
ayDays = 30
Case 12
If Kabiseh(IL) = 1 Then
ayDays = 30
Else
ayDays = 29
End If
End Select
End Function


Function Make_Date(ByVal F_Date As Long) As String
'íß ÊÇÑíÎ ÑÇ ÈÕæÑÊ íß ÑÔÊå 10 ÑÞãí ÈÇ ÐßÑ åÇÑ
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>ÑÞ  ã ÈÑÇí ÓÇá ÇÑÇÆå ãí ßäÏ
Dim d As String
d = Trim(Str(F_Date))
If IsNull(F_Date) = True Or F_Date = 0 Then
Make_Date = ""
Else
Make_Date = Mid(d, 1, 4) & "/" & Mid(d, 5, 2) & "/" & Mid(d, 7, 2)
End If
End Function


Function ILay(ByVal F_Date As Long) As Long
'ÔÔ ÑÞã Çæá ÊÇÑíÎ ßå ãÚÑÝ ÓÇá æ ãÇå ÇÓÊ ÑÇ ÈÑãí ÑÏÇäÏ
ILay = Val(Left$(F_Date, 6))
End Function


Public Function Guon(F_Date As Long) As Byte
'Çíä ÊÇÈÚ ÚÏÏ ãÑÈæØ Èå ÑæÒ íß ÊÇÑíÎ ÑÇ ÈÑãÑÏÇäÏ
Guon = F_Date Mod 100
End Function


Function ay(F_Date As Long) As Byte
'Çíä ÊÇÈÚ ÚÏÏ ãÑÈæØ Èå ãÇå íß ÊÇÑíÎ ÑÇ ÈÑãÑÏÇäÏ
ay = Int((F_Date Mod 10000) / 100)
End Function


Public Function IL(F_Date As Long) As Integer
'Çíä ÊÇÈÚ ÚÏÏ ãÑÈæØ Èå ÓÇá íß ÊÇÑíÎ ÑÇ ÈÑãÑÏÇäÏ
IL = Int(F_Date / 10000)
End Function


Public Function Kabiseh(ByVal OnlyIL As Variant) As Byte
'æÑæÏí ÊÇÈÚ ÚÏÏ ÏæÑÞãí ÇÓÊ
'Çíä ÊÇÈÚ ßÈíÓå ÈæÏä ÓÇá ÑÇ ÈÑãíÑÏÇäÏ
'ÇÑ ÓÇá ßÈíÓå ÈÇÔÏ ÚÏÏ íß æ ÏÑÛíÑ ÇíäÕæÑÊ ÕÝÑ ÑÇ ÈÑ ãíÑÏÇäÏ
Kabiseh = 0
If OnlyIL >= 1375 Then
If (OnlyIL - 1375) Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
ElseIf OnlyIL <= 1370 Then
If (1370 - OnlyIL) Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
End If
End Function


Function Nextay(ByVal IL_ay As Long) As Long
If (IL_ay Mod 100) = 12 Then
Nextay = (Int(IL_ay / 100) + 1) * 100 + 1
Else
Nextay = IL_ay + 1
End If
End Function


Function Previousay(ByVal IL_ay As Long) As Long
If (IL_ay Mod 100) = 1 Then
Previousay = (Int(IL_ay / 100) - 1) * 100 + 12
Else
Previousay = IL_ay - 1
End If
End Function


Public Function Firstday(IL As Integer, ay As Integer) As Long
'ÔãÇÑå Çæáíä ÑæÒ ãÇå
Dim strfd As Long
strfd = IL & Format(ay, "00") & Format(1, "00")
Firstday = DayWeekNo(strfd)
End Function


Public Function Guon1(F_Date As Long) As Byte
'Çíä ÊÇÈÚ ãÔÎÕ ãí ˜äÏ ˜å í˜ ÊÇÑíÎ äÏãíä ÑæÒ ÓÇá ÇÓÊ
ILROOZ = ay(Shamsi()) - 1
If ay(Shamsi()) < 6 Then
Guon1 = (F_Date Mod 100) + (ILROOZ * 30) + (ay(Shamsi())) - 1
Else
Guon1 = (F_Date Mod 100) + (ILROOZ * 30) + 6
End If


End Function

----------


## Hamed_hmt

سلام 
من با access 2016 , windows 10 این ماژولهای شمسی را امتحان کردم، مشکله برام پیش آماده که امیدوارم بتونین کمکم کنین.
وقتی که فرم های نمونه را بررسی میکنم تمامی کدها درست کار میکنند و لی به محض وارد شدن به پنجره build و خروج error به شرح زیر پیغام میدهد.
the expression you entered contains invalid syntax
you may enteredan operandwithout an operator

----------


## amirzazadeh

سلام
دو تا پيشنهاد دارم اميدوارم به دردتون بخوره:
1-اگر ويندوز و افيس شما 32 بيتي هست با كليد G+Ctrl وارد محيط كد نويسي بشيد و يكبار كدهاتون رو كامپايل كنيد اگر كدها مشكلي داشته باشند برنامه متوقف و روي كد مشكل دار متوقف ميشه.
2-اگر ويندوز وافيس 64 بيت هست بايد براي  declare  متغير ها از ptrsafe استفاده كنيد.
........................
موفق باشيد

----------


## bemilove

باسلام
میشه مورد 2 را بیشتر توضیح بدهید
من این مشکل the expression you entered contains invalid syntax access را در کوئری دارم


DLookUp("lngEmpID"؛"t_login"؛"name='" & DMax("[name]"؛"q_login") & "'  ")

یه علامتی تو این کد مشکل داره..البته اولین بار که باز میکنم مشکلی ندارد ، به محضی که می خواهم کد جدیدی در قسمت or  اضاقه کنم ، پیام ارور بالا می دهد

قسمت مشکل داره اینه :       ؛

----------


## linux6020

با سلام
من در اکسل از این دستور استفاده میکنم 
ay(shamsi)


که ماه را به صورت تک رقمی میده مثلا 1   و میخواهم داده را به صورت 01 بدهد و نمیخواهم Format cell را تغییر دهم

من از این دستور میکنم
Private Sub Date21_Click()
ActiveCell.Select
ActiveCell = IL(Shamsi()) & "/" & ay(Shamsi()) & "/" & Me.ActiveControl.Caption
Unload Me

End Sub


چون زمانیکه از دستور  DayWeek استفاده میکنم نمیتواند ماه را بخواند و سیستم هنگ میکند.
اگر 1398/01/18 دیتا باشد DayWeek کار میکند اما اگر 1398/1/18 باشد DayWeek نمیتواند روز هفته را محاسبه کند


ممنون میشوم من را راهنمایی کنید

----------


## mosaArabi

سلام . برای قسمت ماه فرمت تعریف کنید.
("00",(()format(ay(Shami

----------


## linux6020

> سلام . برای قسمت ماه فرمت تعریف کنید.
> ("00",(()format(ay(Shami


با سلام
این کار که شما میگیند یعنی فرمت سل را عوض کنم؟؟

----------


## rosenth

درود
این ماژول سال ۱۴۰۰ به بعد رو صحیح نمایش میده؟

----------


## parsa70

سلام اکثر کدها درست کار میکنه

----------


## OMID452

سلام دوستان
میخواستم از اکتیوایکس جناب آقای پیروزمهر در کوئری استفاده کنم تابع مورد نظر *IsDateBetween*  است که باید به یک فانکشن تبدیل بشه کسی میتونه در این مورد کمک کنه که چطوری این تابع را در کوئری استفاده کنم

----------


## mahdi545

با سلام و عرض ادب خدمت دوستان گرامی

ببخشین میشه بفرمایین چجوری میشه بازه سال رو تغییر داد؟ واسه من از سال 1381 الی 1430 وجود داره که میخام این بازه به سال 1320 تا 1430 تغییر پیدا کنه.

----------


## mahdi545

> با سلام و عرض ادب خدمت دوستان گرامی
> 
> ببخشین میشه بفرمایین چجوری میشه بازه سال رو تغییر داد؟ واسه من از سال 1381 الی 1430 وجود داره که میخام این بازه به سال 1320 تا 1430 تغییر پیدا کنه.


دوستان مشکلم حل شد ممنون

----------

