نوشتن ماكرو تبديل تاريخ

[malit]

با سلام خدمت همگي
من نياز به يك ماكرو براي تبديل تاريخ ميلادي به شمسي در نرم افزار
MSProject
دارم لطفا راهنمائي نمائيد

ممنون :sad

[re_elhami_27]

من دارم برات مي زارم :

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]

من دارم برات مي زارم :

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]

خب توي MSProject ميشه از ماكروهاي VB استفاده كرد

[malit]

ممنون از سورس شما.
ممکن نحوه جایگزین کردن آن با تقویم میلادی Msp را نیز بیان نمائید

[tomcat]

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

[parsafarshad1980]

سلام دوستان
با تشکر از تابعی که در اختیار ما قرار دادید

اما میشه یک خورده توضیح بدید که چطوری از ماکرو های Vb تو Mspاستفاده کنم؟

آخه من دیگه در این حد نیستم ک بتونم اینکارارو بکنم
ممنونتم .

[tomcat]

من زیاد با Msp کار نکردم ولی تا جایی که یادم هست تو اون قسمتس هست که فرمت تاریخ را مشخص می کنید . باید b2 قبل از قرمت وارد کنید مثل زیر
<Code>
b2 yyyy/mm/dd
<Code/>
البته اینم بگم من این کارو با ویندوز 98 و فارسی ساز پارسا 99 می کردم دیگه نمیدونم تو Xp جواب میده یا نه

[_H2_]

سلام
شاید زیاد جوابم بدردتان نخورد ولی شاید متحول شوید و دست از VB6 درپیت عهد دقیانوسی بردارید. :blink:

در VB8 ایرانی ها را تحویل گرفته اند و کلاسس ماژول تاریخ هجری شمسی وجود دارد.
با نام System.Globalization.PersianCalendar
و تاریخ هجری قمری که البته در VB7 هم بود با نام System.Globalization.HijriCalendar

اگر متحول شدید برای توضیحات بیشتر خبرم کنید!

[mJo0T]

اگه میشه از فایل dll استفاده کرد این یکی کارش ردیف :cool: یه راهنمای کامل هم داره ;)

Download ([ برای مشاهده لینک ، لطفا با نام کاربری خود وارد شوید یا ثبت نام کنید ])

[parsafarshad1980]

آقای mJo0T چند تا نکته رو باید خدمتتون عرض کنم

اولاً این فایلی که دادید خراب شده و باز نمیشه!!!!!!!!

دوماً : شما قرار فایل DLL بدید ولی این که EXE است.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!

این کارتون فوق العاده مشکوکه!!!؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

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

دوستان محترم زحمت بکشید و پس از برسی نتیجه این فایل و هم بزارید تا ببینیم که شاید من اشتباه میکنم !؟

ممنون و متشکر

پیروز باشید!