ماژول کامل تاریخ شمسی در اکسس با VBA

[Rasool-GH]

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

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

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


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



/==========================/

ماژول Persian Function (http://barnamenevis.org/attachment.php?attachmentid=80621&d=1326347290)
راهنمای ماژول قسمت 1 (http://barnamenevis.org/attachment.php?attachmentid=80625&d=1326350496)
راهنمای ماژول قسمت 2 (http://barnamenevis.org/attachment.php?attachmentid=80626&d=1326350709)

یک نمونه ماژول کاری از جناب امیری (http://barnamenevis.org/attachment.php?attachmentid=112482&d=1383415599)

یک نمونه OCX کاری از جناب پیروزمهر (http://www.cpsd.ir/pdc.asp?)
(http://www.cpsd.ir/downloads/PDC%20Version%20V2.exe)
/==========================/



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

تنها مورد که باید ذکر بشه 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 عزیز اصلاح کرده بودن اصلاح کردم وبرای استفاده عمومی با اموزش نحوه استفاده در این تاپیک قرار دادم و در او تاپیک قبلی هم ادرس دادم که هر کی به این مطلب نیاز داشت بتونه به یک ماژول سالم به همراه اموزش استفاده از اون دسترسی داشته باشه .
ادعایی برای ارائه مطلب جدیدی نداشتم و ندارم .
اون موردی هم که ذکر کردین ویرایش شده مربوط به

دوستان عزيز لطفا اينجا سوال نپرسين كه اين تاپيك فقط جنبه اموزشي داشته باشه. سوالات رو اينجا (http://barnamenevis.org/showthread.php?320281-%D8%A7%D8%B9%D8%AA%D8%A8%D8%A7%D8%B1-%D8%B3%D9%86%D8%AC%D9%8A-%D8%AA%D8%A7%D8%B1%D9%8A%D8%AE) مطرح كنيد

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

[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 که در ضمیمه آورده شده و با ماژول اصلاح شده زیر هماهنگ هست هم به دلیل تغییر توابع در ماژول آصلاح شده جناب رسولی نیز باید اصلاح شود تا به درستی عمل کند که اگر دوستان زحمت این تغییر را با مآژول اصلاح شده جدید بکشند و تغییرات لازم را انجام دهند ممنون می شیم
لینکی که فایل ضمیمه در آن هست :
http://barnamenevis.org/showthread.php?51987-%D9%85%D8%B4%DA%A9%D9%84%D8%A7%D8%AA-%D9%81%D8%A7%D8%B1%D8%B3%DB%8C-%D9%88-%D8%B3%D9%88%D8%B1%D8%B3-%D9%87%D8%A7%DB%8C-%D9%85%D8%B1%D8%A8%D9%88%D8%B7%D9%87&p=827848&viewfull=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 و اینکه استاد امیری تو تاپیکی مجزا آموزش تقویم قابل ویرایش (http://barnamenevis.org/showthread.php?339004-%D8%AA%D9%82%D9%88%DB%8C%D9%85-%D9%82%D8%A7%D8%A8%D9%84-%D9%88%DB%8C%D8%B1%D8%A7%DB%8C%D8%B4) را ایجاد نمودند که متاسفانه علی رقم اهمیت و کاربردی بودن این مسئله نتوانست مخاطبان خود را جذب کند البته این از دید من بود شاید به دلیل جذابیت فوق العاده اکتیوکسهای 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 و اینکه استاد امیری تو تاپیکی مجزا آموزش تقویم قابل ویرایش (http://barnamenevis.org/showthread.php?339004-%D8%AA%D9%82%D9%88%DB%8C%D9%85-%D9%82%D8%A7%D8%A8%D9%84-%D9%88%DB%8C%D8%B1%D8%A7%DB%8C%D8%B4) را ایجاد نمودند که متاسفانه علی رقم اهمیت و کاربردی بودن این مسئله نتوانست مخاطبان خود را جذب کند البته این از دید من بود شاید به دلیل جذابیت فوق العاده اکتیوکسهای 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%A7%DA%A9%D8%AA%DB%8C%D9%88-%D8%A7%DB%8C%DA%A9%D8%B3-%D9%85%D8%A8%D8%AF%D9%84-%D8%AA%D8%A7%D8%B1%DB%8C%D8%AE-%D9%85%DB%8C%D9%84%D8%A7%D8%AF%DB%8C-%D8%A8%D9%87-%D8%B4%D9%85%D8%B3%DB%8C-%D9%88-%D8%A8%D8%A7%D9%84%D8%B9%DA%A9%D8%B3
من در همه برنامه هام استفاده کردم بدون نقص و خیلی عالی کار میکنه
اینم سایت اصلی
http://cpsd.ir/?

[abdoreza57]

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


سلام

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

خدا نگهدار

[Abbas Amiri]

باسلام خدمت همه اساتید
چرا از این استفاده نمی کنید.
http://npmpro.blogfa.com/post/3/%D8%A7%DA%A9%D8%AA%DB%8C%D9%88-%D8%A7%DB%8C%DA%A9%D8%B3-%D9%85%D8%A8%D8%AF%D9%84-%D8%AA%D8%A7%D8%B1%DB%8C%D8%AE-%D9%85%DB%8C%D9%84%D8%A7%D8%AF%DB%8C-%D8%A8%D9%87-%D8%B4%D9%85%D8%B3%DB%8C-%D9%88-%D8%A8%D8%A7%D9%84%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 (https://barnamenevis.org/#IsDateBetween_Function) است که باید به یک فانکشن تبدیل بشه کسی میتونه در این مورد کمک کنه که چطوری این تابع را در کوئری استفاده کنم

[mahdi545]

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

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

[mahdi545]

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

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

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