سلام . چون متأسفانه نتوانستم لينكش را بيابم كدش را آوردم . اين اوليش :
Function Shamsi(Optional date1 As String, Optional SmallDate1 As Boolean) As String '================================================= === Dim d, P, w, mon, mm, ym, u, v, rp, X, i, ys, ms, dm, p1, d1, ds, DateShamsi d = Array(20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21) P = Array(11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10) w = Array("یکشنبه","دوشنبه","سه شنبه","چهارشنبه","پنج شنبه","جمعه","شنبه") If SmallDate1 = True Then mon = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12") Else mon = Array("اسفند", "بهمن", "دی", "آذر", "آبان", "مهر", "شهریور", "مرداد", "تیر", "خرداد", "اردیبهشت", "فروردین") End If If date1 = "" Then date1 = DateAdd("d", 1, Date) dm = Day(date1) mm = Month(date1) ym = Year(date1) u = 0 rp = 0 If (ym Mod 4) = 0 Then u = 1 If ((ym Mod 100) = 0 And (ym Mod 400) <> 0) Then u = 0 ys = ym - 622 X = ys - 22 X = X Mod 33 If ((X Mod 4) = 0 And X <> 32) Then rp = 1 i = Not (rp - 2) + Not (u - 2) * 2 X = 0 If (i = 0 And mm = 3) Then X = 1 If i = 0 Then i = 3 ms = (9 + mm) Mod 13 If ms < 10 Then ms = ms + 1 d1 = d(mm - 1) If (i = 1 And mm > 2) Then d1 = d1 - 1 If (i = 2 And mm < 3) Then d1 = d1 - 1 p1 = P(mm - 1) If (i = 1 And mm > 2) Then p1 = p1 + 1 If (i = 2 And mm < 4) Then p1 = p1 + 1 If (dm > 0 And dm <= d1) Then ds = p1 + dm + X - 1 X = 1 Else ds = dm - d1 ms = ms + 1 If ms = 13 Then ms = 1 X = 2 End If If ((mm = 3 And X = 2) Or mm > 3) Then ys = ys + 1 ds = Str(ds) If Len(Trim(ds)) = 1 Then ds = "0" + Trim(ds) If SmallDate1 = True Then' اگر سال به صورت دو کارکتری میخواهید خط زیر را از حالت کامنت در آورید' Shamsi = Mid(Trim(Str(Ys)), 3, 2) + "/" + Trim(mon(Ms - 1)) + "/" + Trim(Ds)' اگر سال به صورت چهار کارکتری میخواهید خط زیر را از حالت کامنت در آورید Shamsi = Trim(Str(ys)) + "/" + Trim(mon(ms - 1)) + "/" + Trim(ds) Else Shamsi = w(Weekday(Date) - 1) + " " + Str(ds) + " " + mon(ms - 1) + " " + Str(ys) End IfEnd Function
البته اين توابع و توابع دومي در تاپيك مشكلات فارسي و سورسهاي مربوطه موجود هستند .