مشاهده نسخه کامل
: نوشتن ماكرو تبديل تاريخ
با سلام خدمت همگي
من نياز به يك ماكرو براي تبديل تاريخ ميلادي به شمسي در نرم افزار
MSProject
دارم لطفا راهنمائي نمائيد
ممنون :sad
re_elhami_27
06-03-2006, 17:02
من دارم برات مي زارم :
Public Function m_to_sh(input_date As Date, xxx As Integer) As String
Dim calendar As calender
Dim today, today_sh, this_month, this_year, this_year_sh As Integer
Dim this_month_sh As String
Dim today_sh_text, mm As String
Dim m As Integer
today = Day(input_date)
this_month = Month(input_date)
this_year = Year(input_date)
If (this_year Mod 4) = 0 Then
Select Case this_month
Case 1
m = "01"
calender.start = 11
calender.last = 30
calender.p_month = "دي"
calender.s_month = "بهمن"
'----------------------------'
Case 2
m = "02"
calender.start = 12
calender.last = 30
calender.p_month = "بهمن"
calender.s_month = "اسفند"
'----------------------------'
Case 3
m = "03"
calender.start = 11
calender.last = 29
calender.p_month = "اسفند"
calender.s_month = "فروردين"
'----------------------------'
Case 4
m = "04"
calender.start = 13
calender.last = 31
calender.p_month = "فروردين"
calender.s_month = "ارديبهشت"
'----------------------------'
Case 5
m = "05"
calender.start = 12
calender.last = 31
calender.p_month = "ارديبهشت"
calender.s_month = "خرداد"
'----------------------------'
Case 6
m = "06"
calender.start = 12
calender.last = 31
calender.p_month = "خرداد"
calender.s_month = "تير"
'----------------------------'
Case 7
m = "07"
calender.start = 11
calender.last = 31
calender.p_month = "تير"
calender.s_month = "مرداد"
'----------------------------'
Case 8
m = "08"
calender.start = 11
calender.last = 31
calender.p_month = "مرداد"
calender.s_month = "شهريور"
'----------------------------'
Case 9
m = "09"
calender.start = 11
calender.last = 31
calender.p_month = "شهريور"
calender.s_month = "مهر"
'----------------------------'
Case 10
m = "10"
calender.start = 10
calender.last = 30
calender.p_month = "مهر"
calender.s_month = "آبان"
'----------------------------'
Case 11
m = "11"
calender.start = 11
calender.last = 30
calender.p_month = "آبان"
calender.s_month = "آذر"
'----------------------------'
Case 12
m = "12"
calender.start = 11
calender.last = 30
calender.p_month = "آذر"
calender.s_month = "دي"
End Select
'----------------------------'
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
'----------------------------'
Else
Select Case this_month
Case 1
m = "01"
calender.start = 12
calender.last = 30
calender.p_month = "دي"
calender.s_month = "بهمن"
'----------------------------'
Case 2
m = "02"
calender.start = 13
calender.last = 30
calender.p_month = "بهمن"
calender.s_month = "اسفند"
'----------------------------'
Case 3
m = "03"
calender.start = 11
If ((this_year - 1) Mod 4 = 0) Then
calender.last = 30
Else
calender.last = 29
End If
calender.p_month = "اسفند"
calender.s_month = "فروردين"
'----------------------------'
Case 4
m = "04"
calender.start = 12
calender.last = 31
calender.p_month = "فروردين"
calender.s_month = "ارديبهشت"
'----------------------------'
Case 5
m = "05"
calender.start = 11
calender.last = 31
calender.p_month = "ارديبهشت"
calender.s_month = "خرداد"
'----------------------------'
Case 6
m = "06"
calender.start = 11
calender.last = 31
calender.p_month = "خرداد"
calender.s_month = "تير"
'----------------------------'
Case 7
m = "07"
calender.start = 10
calender.last = 31
calender.p_month = "تير"
calender.s_month = "مرداد"
'----------------------------'
Case 8
m = "08"
calender.start = 10
calender.last = 31
calender.p_month = "مرداد"
calender.s_month = "شهريور"
'----------------------------'
Case 9
m = "09"
calender.start = 10
calender.last = 31
calender.p_month = "شهريور"
calender.s_month = "مهر"
'----------------------------'
Case 10
m = "10"
calender.start = 9
calender.last = 30
calender.p_month = "مهر"
calender.s_month = "آبان"
'----------------------------'
Case 11
m = "11"
calender.start = 10
calender.last = 30
calender.p_month = "آبان"
calender.s_month = "آذر"
'----------------------------'
Case 12
m = "12"
calender.start = 10
calender.last = 30
calender.p_month = "آذر"
calender.s_month = "دي"
End Select
End If
If (this_month > 3) Or (this_month = 3 And today > 19) Then
this_year_sh = (this_year - 622) + 1 + (4 * xxx)
Else
this_year_sh = (this_year - 622) + (4 * xxx)
End If
today_sh = calender.start + today - 1
If today_sh <= calender.last Then
this_month_sh = calender.p_month
Else
this_month_sh = calender.s_month
m = m + 1
today_sh = today_sh - calender.last
End If
If today_sh < 10 Then
today_sh_text = "0" & today_sh
Else
today_sh_text = today_sh
End If
If m < 10 Then
mm = "0" & m
Else
mm = m
End If
m_to_sh = today_sh_text & "," & this_month_sh & "," & this_year_sh
End Function
re_elhami_27
06-03-2006, 17:03
من دارم برات مي زارم :
Public Function m_to_sh(input_date As Date, xxx As Integer) As String
Dim calendar As calender
Dim today, today_sh, this_month, this_year, this_year_sh As Integer
Dim this_month_sh As String
Dim today_sh_text, mm As String
Dim m As Integer
today = Day(input_date)
this_month = Month(input_date)
this_year = Year(input_date)
If (this_year Mod 4) = 0 Then
Select Case this_month
Case 1
m = "01"
calender.start = 11
calender.last = 30
calender.p_month = "دي"
calender.s_month = "بهمن"
'----------------------------'
Case 2
m = "02"
calender.start = 12
calender.last = 30
calender.p_month = "بهمن"
calender.s_month = "اسفند"
'----------------------------'
Case 3
m = "03"
calender.start = 11
calender.last = 29
calender.p_month = "اسفند"
calender.s_month = "فروردين"
'----------------------------'
Case 4
m = "04"
calender.start = 13
calender.last = 31
calender.p_month = "فروردين"
calender.s_month = "ارديبهشت"
'----------------------------'
Case 5
m = "05"
calender.start = 12
calender.last = 31
calender.p_month = "ارديبهشت"
calender.s_month = "خرداد"
'----------------------------'
Case 6
m = "06"
calender.start = 12
calender.last = 31
calender.p_month = "خرداد"
calender.s_month = "تير"
'----------------------------'
Case 7
m = "07"
calender.start = 11
calender.last = 31
calender.p_month = "تير"
calender.s_month = "مرداد"
'----------------------------'
Case 8
m = "08"
calender.start = 11
calender.last = 31
calender.p_month = "مرداد"
calender.s_month = "شهريور"
'----------------------------'
Case 9
m = "09"
calender.start = 11
calender.last = 31
calender.p_month = "شهريور"
calender.s_month = "مهر"
'----------------------------'
Case 10
m = "10"
calender.start = 10
calender.last = 30
calender.p_month = "مهر"
calender.s_month = "آبان"
'----------------------------'
Case 11
m = "11"
calender.start = 11
calender.last = 30
calender.p_month = "آبان"
calender.s_month = "آذر"
'----------------------------'
Case 12
m = "12"
calender.start = 11
calender.last = 30
calender.p_month = "آذر"
calender.s_month = "دي"
End Select
'----------------------------'
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
'----------------------------'
Else
Select Case this_month
Case 1
m = "01"
calender.start = 12
calender.last = 30
calender.p_month = "دي"
calender.s_month = "بهمن"
'----------------------------'
Case 2
m = "02"
calender.start = 13
calender.last = 30
calender.p_month = "بهمن"
calender.s_month = "اسفند"
'----------------------------'
Case 3
m = "03"
calender.start = 11
If ((this_year - 1) Mod 4 = 0) Then
calender.last = 30
Else
calender.last = 29
End If
calender.p_month = "اسفند"
calender.s_month = "فروردين"
'----------------------------'
Case 4
m = "04"
calender.start = 12
calender.last = 31
calender.p_month = "فروردين"
calender.s_month = "ارديبهشت"
'----------------------------'
Case 5
m = "05"
calender.start = 11
calender.last = 31
calender.p_month = "ارديبهشت"
calender.s_month = "خرداد"
'----------------------------'
Case 6
m = "06"
calender.start = 11
calender.last = 31
calender.p_month = "خرداد"
calender.s_month = "تير"
'----------------------------'
Case 7
m = "07"
calender.start = 10
calender.last = 31
calender.p_month = "تير"
calender.s_month = "مرداد"
'----------------------------'
Case 8
m = "08"
calender.start = 10
calender.last = 31
calender.p_month = "مرداد"
calender.s_month = "شهريور"
'----------------------------'
Case 9
m = "09"
calender.start = 10
calender.last = 31
calender.p_month = "شهريور"
calender.s_month = "مهر"
'----------------------------'
Case 10
m = "10"
calender.start = 9
calender.last = 30
calender.p_month = "مهر"
calender.s_month = "آبان"
'----------------------------'
Case 11
m = "11"
calender.start = 10
calender.last = 30
calender.p_month = "آبان"
calender.s_month = "آذر"
'----------------------------'
Case 12
m = "12"
calender.start = 10
calender.last = 30
calender.p_month = "آذر"
calender.s_month = "دي"
End Select
End If
If (this_month > 3) Or (this_month = 3 And today > 19) Then
this_year_sh = (this_year - 622) + 1 + (4 * xxx)
Else
this_year_sh = (this_year - 622) + (4 * xxx)
End If
today_sh = calender.start + today - 1
If today_sh <= calender.last Then
this_month_sh = calender.p_month
Else
this_month_sh = calender.s_month
m = m + 1
today_sh = today_sh - calender.last
End If
If today_sh < 10 Then
today_sh_text = "0" & today_sh
Else
today_sh_text = today_sh
End If
If m < 10 Then
mm = "0" & m
Else
mm = m
End If
m_to_sh = today_sh_text & "," & this_month_sh & "," & this_year_sh
End Function
البته مي بخشيد اين براي ويژوال بيسيك است
Mostafa1024
07-03-2006, 18:43
خب توي MSProject ميشه از ماكروهاي VB استفاده كرد
ممنون از سورس شما.
ممکن نحوه جایگزین کردن آن با تقویم میلادی Msp را نیز بیان نمائید
دوست عزیز اگه سیستم عاملت از تاریخ شمسی پشتیبانی میکنه کافی یه b2 قبل از فرمت تاریخ اضافه کنی درست میشه . اگر هم از تاریخ شمسی پشتیبانی نکنه این تاریخ رو به قمری بهت میده
parsafarshad1980
19-02-2007, 06:14
سلام دوستان
با تشکر از تابعی که در اختیار ما قرار دادید
اما میشه یک خورده توضیح بدید که چطوری از ماکرو های Vb تو Mspاستفاده کنم؟
آخه من دیگه در این حد نیستم ک بتونم اینکارارو بکنم
ممنونتم .
من زیاد با Msp کار نکردم ولی تا جایی که یادم هست تو اون قسمتس هست که فرمت تاریخ را مشخص می کنید . باید b2 قبل از قرمت وارد کنید مثل زیر
<Code>
b2 yyyy/mm/dd
<Code/>
البته اینم بگم من این کارو با ویندوز 98 و فارسی ساز پارسا 99 می کردم دیگه نمیدونم تو Xp جواب میده یا نه
سلام
شاید زیاد جوابم بدردتان نخورد ولی شاید متحول شوید و دست از VB6 درپیت عهد دقیانوسی بردارید. :blink:
در VB8 ایرانی ها را تحویل گرفته اند و کلاسس ماژول تاریخ هجری شمسی وجود دارد.
با نام System.Globalization.PersianCalendar
و تاریخ هجری قمری که البته در VB7 هم بود با نام System.Globalization.HijriCalendar
اگر متحول شدید برای توضیحات بیشتر خبرم کنید!
اگه میشه از فایل dll استفاده کرد این یکی کارش ردیف :cool: یه راهنمای کامل هم داره ;)
Download ([ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ])
parsafarshad1980
25-02-2007, 00:40
آقای mJo0T چند تا نکته رو باید خدمتتون عرض کنم
اولاً این فایلی که دادید خراب شده و باز نمیشه!!!!!!!!
دوماً : شما قرار فایل DLL بدید ولی این که EXE است.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!
این کارتون فوق العاده مشکوکه!!!؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟
یا اشتیاه نوشتید!؟! یا باید عرض کنم که دوست گرامی اینجا جای اینکارا نیست!!!!
دوستان محترم زحمت بکشید و پس از برسی نتیجه این فایل و هم بزارید تا ببینیم که شاید من اشتباه میکنم !؟
ممنون و متشکر
پیروز باشید!
vBulletin , Copyright ©2000-2024, Jelsoft Enterprises Ltd.