اضافه کردن ماه به تاریخ فارسی

[daghyad]

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

Function J_addmonth(Jdate1 As String, addmonth As Integer)
Dim mah As Integer
Dim rooz As Integer
Dim sal As Integer
 rooz = Right(Jdate1, 2)
  mah = (Right(Left(Jdate1, 7), 2) + addmonth)
 
If mah Mod 12 = 0 Then
sal = Left(Jdate1, 4) + (Int(mah / 12)) - 1
Else
sal = Left(Jdate1, 4) + (Int(mah / 12))
'ÊÇ ÇíäÌÇ ÓÇá ÈÏÓÊ ãí ÇíÏ
End If
 
If mah Mod 12 = 0 Then
mah = 12
Else
mah = mah Mod 12
End If
If rooz = 31 And (mah Mod 12 = 0) Then
    rooz = rooz - 1
  
ElseIf rooz = 31 And (mah Mod 12 > 6) Then
    rooz = rooz
End If
If mah < 9 And rooz > 9 Then
J_addmonth = (sal) & "/0" & (mah) & "/" & (rooz)
ElseIf mah < 9 And rooz < 9 Then
J_addmonth = (sal) & "/0" & (mah) & "/0" & (rooz)
ElseIf mah > 9 And rooz < 9 Then
J_addmonth = (sal) & "/" & (mah) & "/0" & (rooz)
Else
J_addmonth = (sal) & "/" & (mah) & "/" & (rooz)
End If
    
End Function 

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

Sub fff()
  
 Dim Jdate1 As String, mah1 As Integer
 Jdate1 = "1392/05/31"
 addmonth = 8
 mah = (Right(Left(Jdate1, 7), 2) + addmonth)
 rooz = Right(Jdate1, 2)
 sal1 = Left(Jdate1, 4)
 MsgBox sal1
If mah Mod 12 = 0 Then
sal = Left(Jdate1, 4) + (Int(mah / 12)) - 1
Else
sal = Left(Jdate1, 4) + (Int(mah / 12))
'ÊÇ ÇíäÌÇ ÓÇá ÈÏÓÊ ãí ÇíÏ
End If
 
If mah Mod 12 = 0 Then
mah = 12
Else
mah = mah Mod 12
End If
If rooz = 31 And (mah Mod 12 = 0) Then
    rooz = rooz - 1
  
ElseIf rooz = 31 And (mah Mod 12 > 6) Then
    rooz = rooz
End If
If mah < 9 And rooz > 9 Then
jaddmonth = (sal) & "/0" & (mah) & "/" & (rooz)
ElseIf mah < 9 And rooz < 9 Then
jaddmonth = (sal) & "/0" & (mah) & "/0" & (rooz)
ElseIf mah > 9 And rooz < 9 Then
jaddmonth = (sal) & "/" & (mah) & "/0" & (rooz)
Else
jaddmonth = (sal) & "/" & (mah) & "/" & (rooz)
End If
MsgBox jaddmonth
 End Sub 

[~M*E*H*D*I~]

تابع رو چطوری فراخوانی می کنی؟

[daghyad]

در وی بی

Sub GF()
Dim Date1 As String
Dim addmonth As Integer
 Date1 = Application.InputBox(Prompt:= _
        "Please enter DATE", Type:=1)
   addmonth = Application.InputBox(Prompt:= _
        "Please enter MONTH", Type:=1)
    MsgBox "The NEW DATE is " & J_addmonth(Date1, addmonth)
End Sub 

در شیت هم مثل سایر توابع

[~M*E*H*D*I~]

در وی بی

Sub GF()
Dim Date1 As String
Dim addmonth As Integer
 Date1 = Application.InputBox(Prompt:= _
        "Please enter DATE", Type:=1)
   addmonth = Application.InputBox(Prompt:= _
        "Please enter MONTH", Type:=1)
    MsgBox "The NEW DATE is " & J_addmonth(Date1, addmonth)
End Sub 

در شیت هم مثل سایر توابع

اگر میخوای تو شیت استفاده کنی که باید public باشه و آرگومان هایی که تعریف کردی از نظر نوع متغیر همخوانی داشته باشند بعد میرسه به جزئیات دقیقا میخوای چه کاری با این تابع انجام بدی

[daghyad]

سلام امتحان کردم با public هم جواب نداد از تابع val هم استفاده کردم گفتم شاید استرینگ ها را نمی تونه با int جمع کنه
دوستان ببینند می تونند کاملش کنند البته یه شرط هم باید برای سال کبیسه استفاد] کنم تا هر جا 30 اسفند نداریم به جاش از 29 اسفند استفاده کنه

[daghyad]

اساتید ممنون کسی میتونه اصلاح کنه کد را این کد را من به صورت فرمولی و در ساب ساده به نتیجه رساندم اما در فانکشن نشده علت چیست؟

[~M*E*H*D*I~]

اینو ببین

[امين اسماعيلي]

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

Sub GF()
Dim Jdate1 As String
Dim addmonth As Integer
 Jdate1 = InputBox("please Enter your date", "month function")
 addmonth = InputBox("please Enter your month", "month function")
    MsgBox "The NEW DATE is " & J_addmonth(Jdate1, addmonth)
    
End Sub

[امين اسماعيلي]

با درود

یا از کد زیر

Sub GF1()
Dim Jdate1 As String
Dim addmonth As Integer
 Jdate1 = Application.InputBox(Prompt:= _
        "Please enter DATE", Type:=2)
   addmonth = Application.InputBox(Prompt:= _
        "Please enter MONTH", Type:=1)
    MsgBox "The NEW DATE is " & J_addmonth(Jdate1, addmonth)
End Sub

type=1 رو برداشتم ;کردیمش type=2 چون string میخواستیم. تو اولی و اسم متغییر هاتو هم درست کردم چون همخونی نداشت . همونی که جناب وطن پرستم گفتن

[امين اسماعيلي]

با درود مجدد

یه توضیح کوچلو در مورد type توی input box

[TABLE]
[TR]
[TH]Type[/TH]
 		[TH]Meaning[/TH]
 	[/TR]
 	[TR]
 		[TD]0[/TD]
 		[TD]A formula[/TD]
 	[/TR]
 	[TR]
 		[TD]1[/TD]
 		[TD]A number[/TD]
 	[/TR]
 	[TR]
 		[TD]2[/TD]
 		[TD]Text (a string)[/TD]
 	[/TR]
 	[TR]
 		[TD]4[/TD]
 		[TD]A logical value ([B]True or [B]False)[/B][/B][/TD]
 	[/TR]
 	[TR]
 		[TD]8[/TD]
 		[TD]A cell reference, as a [B]Range object[/B][/TD]
 	[/TR]
 	[TR]
 		[TD]16[/TD]
 		[TD]An error value, such as #N/A[/TD]
 	[/TR]
 	[TR]
 		[TD]64[/TD]
 		[TD]An array of values
[/TD]
[/TR]
[/TABLE]