ساخت ماشین حساب حروفی

[karem2074]

با سلام
دوستان من میخوام یک ماشین حساب حروفی شبیه عکس زیر بسیازم.ممنون میشم در این رابطه راهنمایی کنید یا پروژه رو برام بذارید.


http://barnamenevis.org/attachment.php?attachmentid=78638&cid=1&stc=1

[mr-adler]

سلام

یا پروژه رو برام بذارید.
خلافه....:لبخند::بامزه:

دوستان من میخوام یک ماشین حساب حروفی شبیه عکس زیر بسیازم.ممنون میشم در این رابطه راهنمایی کنیبه راحتی میشه نوشتش اما ....
یه مشکل تقریبا کوچیک(خیلی بزرگ!)هست که اگه حل بشه باقی راه اسونه.
و اما مشکل چیه؟بزارید یه مثال بزنم:
مثلا فرض کنیم روی کامند حاوی عدد یک کلیک کردیم و متن "یک" در تکست باکس ظاهر شد.با وارد کردن عدد دوم کلمه "یک" که در تکست باکس بود به کل عوض شده و تبدیل به چیز جدیدی میشه و این روند ادامه داره.هر موقع که ما عدد جدیدی رو وارد میکنیم متن اعداد نخستین تغییر میکنه:
یک
ده
صد و هشت
هزار و هشتاد
و.....
اگه این مشکل بر طرف بشه باقیش اسون میشه...
و اما شما دو راه بیشتر ندارید:
1.بگید در کل پروژتون عوض بشه
2.مشکل بالا رو برای استاد اعلام کنید و بگید که این پروژه برای اعداد تک رقمی انجام بشه.

موفق باشید....

[karem2074]

دوست گرامی من این پروژه رو به یک صورت دیگه دارم(از دو TEXTBOX تشکیل شده که یکی اعداد رو مینویسه و دیگری اعداد نوشته شده را به صورت حروف مینویسه).این پروژه که من دارم از دو قسمت تشکیل شده.یک قسمت کدهای موجود در Form1 هست و دیگری یک ماژول هست که کدهای لازم جهت ترجمه اعداد به حروف در اون قرار داده شده است.
اگه بتونید کدهای ماژول رو در form1 قرار بدید(کلا از یک قسمت یعنی فقط از Form1 تشکیل شود(بدون ماژول)) که خیلی خیلی خوب میشه.ممنون میشم این کارو برام انجام چون خیلی به این پروژه احتیاج دارم.

لینک دانلود پروژه:
http://up5.iranblog.com/images/hktk73cb5k7c8i62xah.zip

[mr-adler]

لینک دانلود پروژه:
سعی کن تو سرور سایت اپلود کنی اینجور گرفتنش راحت تره.

اگه بتونید کدهای ماژول رو در form1 قرار بدید(کلا از یک قسمت یعنی فقط از Form1 تشکیل شود(بدون ماژول)) که خیلی خیلی خوب میشه.ممنون میشم این کارو برام انجام چون خیلی به این پروژه احتیاج دارم.قبلش باید بگم پروژه واقعا جالبی بود.فکر نمیکردم بشه کاریش کرد اما مثل اینکه شد.(راستی برای اعداد بالای 19 رقم تعریف نشده که مهم نیست...)
اینم پروژه بدون ماژول . تا اونجایی که من امتحان کردم مشکلی نداشت:

78674

[karem2074]

سعی کن تو سرور سایت اپلود کنی اینجور گرفتنش راحت تره.
قبلش باید بگم پروژه واقعا جالبی بود.فکر نمیکردم بشه کاریش کرد اما مثل اینکه شد.(راستی برای اعداد بالای 19 رقم تعریف نشده که مهم نیست...)
اینم پروژه بدون ماژول . تا اونجایی که من امتحان کردم مشکلی نداشت:

78674

ممنونم.اما دوباره پروژه رو چک کنین چون مشکل داره.

[karem2074]

کسی نبود کمک کنه؟

[adib202]

آقا / خانم karem2074 ،شما در همين تالار يك تاپيك با همين موضوع و سوالاتون رو مطرح كردين كه يك سري از دوستان و از جمله خود بنده پاسخ هايي به شما داديم،حالا اينكه تا چه حد خود شما روي همين سوالتون وقت ميزارين رو بنده نميدونم.فكر نمي كنم ديگه نيازي به ايجاد تاپيك جديد براي يك سوال تكراري باشه...
http://barnamenevis.org/showthread.php?315662-%D8%B3%D8%A7%D8%AE%D8%AA-%D9%85%D8%A7%D8%B4%DB%8C%D9%86-%D8%AD%D8%B3%D8%A7%D8%A8-%D8%AD%D8%B1%D9%88%D9%81%DB%8C

[karem2074]

آقا / خانم karem2074 ،شما در همين تالار يك تاپيك با همين موضوع و سوالاتون رو مطرح كردين كه يك سري از دوستان و از جمله خود بنده پاسخ هايي به شما داديم،حالا اينكه تا چه حد خود شما روي همين سوالتون وقت ميزارين رو بنده نميدونم.فكر نمي كنم ديگه نيازي به ايجاد تاپيك جديد براي يك سوال تكراري باشه...
http://barnamenevis.org/showthread.php?315662-%D8%B3%D8%A7%D8%AE%D8%AA-%D9%85%D8%A7%D8%B4%DB%8C%D9%86-%D8%AD%D8%B3%D8%A7%D8%A8-%D8%AD%D8%B1%D9%88%D9%81%DB%8C


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

[aleas2]

سلام خسته نباشید اینم برنامه ات بدون ماژول فقط خودت بعد یه چک کن ببین اینارو درست تعریف کردم
Dim l As Integer
Dim lsp As Integer, chp, sdp, syp, S2 As String
Dim lsp As Integer, chp, ssp, sdp, syp, S1, S2 As String
Dim lsp As Integer, sfp, sss, ssp, S2 As String

از بالا سورس نگاه کن بیا پایین این متغییر هایی که تعریف شده چک کن ببین درسته هر چند بنده برنامه رو اجرا کردم مشکلی نداشت

دانلود برنامه (http://up7.iranblog.com/images/bsw60uyy9dcib5saj7.zip)

ضمنا" دوست عزیز در تاپیک قبلی خودتون سعی کردین کد ماژول به فرم انتقال بدین که به یک سری از خطا ها بر خوردین ولی خطا رو نگفته بودین که دوستان راهنمایتون کنن
اون خطا مربوط به تعریف نشدن متغیر ها بوده که چون شما در بالای کد فرم نوشتین Option Explicit یعنی کدنویسی استاندارد باشه و درنتیجه باید همه متغیر ها تعریف میشدن ولی تو کد ماژول Option Explicit تعریف نشده بود و همینطور متغیر هارو تعریف نکرده بودین برای اینکه کد نویسی ماژول به فرم انتقال بدین یا می بایست کد Option Explicit از بالای کدهای فرم حذف کنین یا متغیر های ماژول تعریف کنین اگر همون سورسی که همراه با ماژول هسته این کد بالای کد های ماژول اضافه کنین Option Explicit میبینین همون خطا هایی که موقع انتقال کد به فرم میداد میده

[karem2074]

سلام خسته نباشید اینم برنامه ات بدون ماژول فقط خودت بعد یه چک کن ببین اینارو درست تعریف کردم
Dim l As Integer
Dim lsp As Integer, chp, sdp, syp, S2 As String
Dim lsp As Integer, chp, ssp, sdp, syp, S1, S2 As String
Dim lsp As Integer, sfp, sss, ssp, S2 As String

از بالا سورس نگاه کن بیا پایین این متغییر هایی که تعریف شده چک کن ببین درسته هر چند بنده برنامه رو اجرا کردم مشکلی نداشت

دانلود برنامه (http://up7.iranblog.com/images/bsw60uyy9dcib5saj7.zip)

ضمنا" دوست عزیز در تاپیک قبلی خودتون سعی کردین کد ماژول به فرم انتقال بدین که به یک سری از خطا ها بر خوردین ولی خطا رو نگفته بودین که دوستان راهنمایتون کنن
اون خطا مربوط به تعریف نشدن متغیر ها بوده که چون شما در بالای کد فرم نوشتین Option Explicit یعنی کدنویسی استاندارد باشه و درنتیجه باید همه متغیر ها تعریف میشدن ولی تو کد ماژول Option Explicit تعریف نشده بود و همینطور متغیر هارو تعریف نکرده بودین برای اینکه کد نویسی ماژول به فرم انتقال بدین یا می بایست کد Option Explicit از بالای کدهای فرم حذف کنین یا متغیر های ماژول تعریف کنین اگر همون سورسی که همراه با ماژول هسته این کد بالای کد های ماژول اضافه کنین Option Explicit میبینین همون خطا هایی که موقع انتقال کد به فرم میداد میده

خیلی خیلی ازتون ممنونم.پروژه این دفعه درست کار میکنه.بازم خیلی ممنونم

[vbhamed]

سلام
خلافه....:لبخند::بامزه:
به راحتی میشه نوشتش اما ....
یه مشکل تقریبا کوچیک(خیلی بزرگ!)هست که اگه حل بشه باقی راه اسونه.
و اما مشکل چیه؟بزارید یه مثال بزنم:
مثلا فرض کنیم روی کامند حاوی عدد یک کلیک کردیم و متن "یک" در تکست باکس ظاهر شد.با وارد کردن عدد دوم کلمه "یک" که در تکست باکس بود به کل عوض شده و تبدیل به چیز جدیدی میشه و این روند ادامه داره.هر موقع که ما عدد جدیدی رو وارد میکنیم متن اعداد نخستین تغییر میکنه:
یک
ده
صد و هشت
هزار و هشتاد
و.....
اگه این مشکل بر طرف بشه باقیش اسون میشه...
و اما شما دو راه بیشتر ندارید:
1.بگید در کل پروژتون عوض بشه
2.مشکل بالا رو برای استاد اعلام کنید و بگید که این پروژه برای اعداد تک رقمی انجام بشه.

موفق باشید....

سلام

اين پروژه اصلا مشكل خاصي نداره
اينهمه نمونه پروژه ماشين حساب تو اينترنت هست
فقط كافيه يكيشون رو بگيريد و يك تكست باكس بهش اضافه كنيد و تو تكست باكس جديد، عدد بدست آمده در تكست باكس جواب رو به حروف تبديل كنيد و تكست باكس جواب رو مخفي كنيد

[mr-adler]

سلام

فقط كافيه يكيشون رو بگيريد و يك تكست باكس بهش اضافه كنيد و تو تكست باكس جديد، عدد بدست آمده در تكست باكس جواب رو به حروف تبديل كنيد و تكست باكس جواب رو مخفي كنيد
منظور من هم دقیقا همینه.فقط مشکلش اونجایی بود که با افزایش ارقام نوشته فارسی به کل تغییر میکرد.مثلا اگه میشد مفهوم کلمه هزار رو به صورت"هزار" نمینوشتیم و فقط مینوشتیم "صفر و صفر و صفر و یک"اینطوری خیلی راحت تر و ساده تر میشد.

[karem2074]

دوستان میشه همین پروژه رو به یک شکل دیگه برام بذارین؟پروژه همین باشه فقط کدهاش فرق بکنه.ممنون میشم به یک صورت دیگه برام بذارین.

[karem2074]

کسی نبود جوابمو بده؟

[IamOverlord]

ببین این کداش فرق می کنه؟(!):

Option Explicit
Private Month_Name, Spring_Fall
Private Time_Difference, Time_Client
Private Base_Year

Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean

Public Const ICC_USEREX_CLASSES = &H200
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Private Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type

Private Const hezar = " åÒÇÑ"
Private Const melun = " ãíáíæä"
Private Const melyard = " ãíáíÇÑÏ"
Private Const va = " æ "

'--- Farsi Number Convertor ------------------'

Public Function heji_adad(ByVal adad As Double) As String
Dim hooroof As String
Dim SS As Integer 'sadgan
Dim hh As Integer 'hezargan
Dim mm As Integer 'melungan
Dim yy As Integer 'melyardgan
Dim STRadad As String
Dim LENadad As Integer

STRadad = Str(Val(Str(adad)))
LENadad = Len(STRadad)

Select Case adad
Case Is = 0
hooroof = "ÕÝÑ"
Case 1 To 999
hooroof = Adad_Heji(adad)

Case 1000 To 999999

If (adad Mod 1000 = 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar
If (adad Mod 1000 <> 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar + va + (Adad_Heji(adad Mod 1000))

Case 1000000 To 999999999

SS = Val(Mid$(STRadad, 3))
hh = Val(Mid$(STRadad, LENadad - 5, 3))
mm = Val(Mid$(STRadad, LENadad - 6))

If (SS = 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)
If (SS <> 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)

Case 1000000000 To 999999999999#

SS = Val(Mid$(STRadad, 3))
hh = Val(Mid$(STRadad, LENadad - 5, 3))
mm = Val(Mid$(STRadad, LENadad - 8, 3))
yy = Val(Mid$(STRadad, LENadad - 9))

If (SS = 0 And hh = 0 And mm = 0) Then hooroof = Adad_Heji(yy) + melyard
If (SS = 0 And hh = 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)

Case Is > 999999999999#
hooroof = "ÚÏÏ æÇÑÏ ÔÏå ÎÇÑÌ ÇÒ ãÍÏæÏå ãí ÈÇÔÏ "

End Select
heji_adad = hooroof
End Function

Private Function Adad_Heji(ByVal adad As Integer) As String
Dim yekan As Byte
Dim dahgan As Byte
Dim sadgan As Byte
Dim behooroof As String

Dim heji(19) As String
Dim heji_dahgan(9) As String
Dim heji_sadgan(9) As String
'-------------------------------
heji(1) = "íß": heji(2) = "Ïæ": heji(3) = "Óå": heji(4) = "åÇÑ": heji(5) = "äÌ"
heji(6) = "ÔÔ": heji(7) = "åÝÊ": heji(8) = "åÔÊ": heji(9) = "äå": heji(10) = "Ïå"
heji(11) = "íÇÒÏå": heji(12) = "ÏæÇÒÏå": heji(13) = "ÓíÒÏå": heji(14) = "åÇÑÏå": heji(15) = "ÇäÒÏå"
heji(16) = "ÔÇäÒÏå": heji(17) = "åÝÏå": heji(18) = "åíÌÏå": heji(19) = "äæÒÏå"
'-------------------------------
heji_dahgan(1) = "Ïå"
heji_dahgan(2) = "ÈíÓÊ"
heji_dahgan(3) = "Óí": heji_dahgan(4) = "åá": heji_dahgan(5) = " äÌÇå"
heji_dahgan(6) = "ÔÕÊ": heji_dahgan(7) = "åÝÊÇÏ": heji_dahgan(8) = "åÔÊÇÏ"
heji_dahgan(9) = "äæÏ"
'------------------------
heji_sadgan(1) = "íßÕÏ": heji_sadgan(2) = "ÏæíÓÊ": heji_sadgan(3) = "ÓíÕÏ"
heji_sadgan(4) = "åÇÑÕÏ": heji_sadgan(5) = "ÇäÕÏ": heji_sadgan(6) = "ÔÔÕÏ"
heji_sadgan(7) = "åÝÊÕÏ": heji_sadgan(8) = "åÔÊÕÏ": heji_sadgan(9) = "äåÕÏ"
'------------------------------------------------------------------------------------------------------------
yekan = adad Mod 10
dahgan = adad Mod 100
sadgan = Int(adad / 100)
'------------------------------------------------------------------------------------------------------------
If dahgan < 20 Then
If (sadgan = 0) Then behooroof = heji(dahgan)
If (sadgan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji(dahgan)
If (yekan = 0 And dahgan = 0) Then behooroof = heji_sadgan(sadgan)
Else
dahgan = (adad Mod 100) - yekan
If (sadgan = 0 And yekan = 0) Then behooroof = heji_dahgan(dahgan / 10)
If (sadgan = 0 And yekan <> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)
If (sadgan <> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)
If (sadgan <> 0 And yekan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10) + va + heji(yekan)
End If
Adad_Heji = behooroof
End Function

Private Function change_mony(ByVal Pol As Currency) As String
Dim P As String, p1 As String
Dim P2 As String, P3 As String
Dim P4 As String, Sk As String
Dim L As Byte
If Pol > 0 Then
P = Str(Pol)
Sk = Right(Trim(P), 3)
p1 = harf(Val(Trim(Sk)))
p1 = Trim(p1) & " ÑíÇá"
If Len(Trim(P)) > 3 Then
Sk = Right(Trim(P), 6)
L = Len(Trim(Sk))
Sk = Left(Trim(Sk), (L - 3))
P2 = harf(Val(Trim(Sk)))
P2 = Trim(P2) & " åÒÇÑ æ "
End If
If Len(Trim(P)) > 6 Then
Sk = Right(Trim(P), 9)
L = Len(Trim(Sk))
Sk = Left(Trim(Sk), (L - 6))
P3 = harf(Val(Trim(Sk)))
P3 = Trim(P3) & " ãíáíæä æ"
End If
If Len(Trim(P)) = 10 Then
Sk = Left(Trim(P), 1)
P4 = harf(Val(Trim(Sk)))
P4 = Trim(P4) & " ãíáíÇÑÏ æ "
End If
change_mony = Trim(P4) & Trim(P3) & Trim(P2) & Trim(p1)
End If
End Function

Private Function harf(mony2 As Long) As String
Dim S As String, S1 As String
Dim s2 As String, s3 As String
S = Trim(Str(mony2))
If Len(Trim(Str(mony2))) = 1 Then S = "00" & Trim(Str(mony2))
If Len(Trim(Str(mony2))) = 2 Then S = "0" & Trim(Str(mony2))
Select Case Left(Trim(S), 1)
Case 0
S1 = ""
Case 1
S1 = "íßÕÏ "
Case 2
S1 = "ÏæíÓÊ "
Case 3
S1 = "ÓíÕÏ"
Case 4
S1 = "åÇÑÕÏ"
Case 5
S1 = "ÇäÕÏ"
Case 6
S1 = "ÔÔÕÏ"
Case 7
S1 = "åÝÊÕÏ"
Case 8
S1 = "åÔÊÕÏ"
Case 9
S1 = "äåÕÏ"
End Select
Select Case Mid(Trim(S), 2, 1)
Case 0
s2 = ""
Case 1
Select Case Right(Trim(S), 1)
Case 0
s2 = "Ïå"
Case 1
s2 = "íÇÒÏå"
Case 2
s2 = "ÏæÇÒÏå"
Case 3
s2 = "ÓíÒÏå"
Case 4
s2 = "åÇÑÏå"
Case 5
s2 = "ÇäÒÏå"
Case 6
s2 = "ÔÇäÒÏå"
Case 7
S1 = "åÝÏå"
Case 8
S1 = "åÌÏå"
Case 9
S1 = "äæÒÏå"
End Select
Case 2
s2 = "ÈíÓÊ "
Case 3
s2 = "Óí "
Case 4
s2 = " åá"
Case 5
s2 = " äÌÇå"
Case 6
s2 = "ÔÕÊ "
Case 7
s2 = "åÝÊÇÏ"
Case 8
s2 = "åÔÊÇÏ"
Case 9
s2 = "äæÏ"
End Select
If Mid(Trim(S), 2, 1) <> 1 Then
Select Case Right(Trim(S), 1)
Case 0
s3 = ""
Case 1
s3 = "íß"
Case 2
s3 = "Ïæ"
Case 3
s3 = "Óå"
Case 4
s3 = "åÇÑ"
Case 5
s3 = "äÌ"
Case 6
s3 = "ÔÔ"
Case 7
s3 = "åÝÊ"
Case 8
s3 = "åÔÊ"
Case 9
s3 = "äå"
End Select
End If
If Trim(S1) <> "" Then S1 = S1 & " æ"
If Trim(s2) <> "" Then s2 = s2 & " æ"
If Trim(s3) <> "" Then s3 = s3 & " æ"
S = S1 & s2 & s3
If Trim(S) <> "" Then harf = Left(Trim(S), (Len(Trim(S)) - 1)) Else harf = ""
End Function

[karem2074]

ببین این کداش فرق می کنه؟(!):

Option Explicit
Private Month_Name, Spring_Fall
Private Time_Difference, Time_Client
Private Base_Year

Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean

Public Const ICC_USEREX_CLASSES = &H200
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Private Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type

Private Const hezar = " åÒÇÑ"
Private Const melun = " ãíáíæä"
Private Const melyard = " ãíáíÇÑÏ"
Private Const va = " æ "

'--- Farsi Number Convertor ------------------'

Public Function heji_adad(ByVal adad As Double) As String
Dim hooroof As String
Dim SS As Integer 'sadgan
Dim hh As Integer 'hezargan
Dim mm As Integer 'melungan
Dim yy As Integer 'melyardgan
Dim STRadad As String
Dim LENadad As Integer

STRadad = Str(Val(Str(adad)))
LENadad = Len(STRadad)

Select Case adad
Case Is = 0
hooroof = "ÕÝÑ"
Case 1 To 999
hooroof = Adad_Heji(adad)

Case 1000 To 999999

If (adad Mod 1000 = 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar
If (adad Mod 1000 <> 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar + va + (Adad_Heji(adad Mod 1000))

Case 1000000 To 999999999

SS = Val(Mid$(STRadad, 3))
hh = Val(Mid$(STRadad, LENadad - 5, 3))
mm = Val(Mid$(STRadad, LENadad - 6))

If (SS = 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)
If (SS <> 0 And hh <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)

Case 1000000000 To 999999999999#

SS = Val(Mid$(STRadad, 3))
hh = Val(Mid$(STRadad, LENadad - 5, 3))
mm = Val(Mid$(STRadad, LENadad - 8, 3))
yy = Val(Mid$(STRadad, LENadad - 9))

If (SS = 0 And hh = 0 And mm = 0) Then hooroof = Adad_Heji(yy) + melyard
If (SS = 0 And hh = 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)

Case Is > 999999999999#
hooroof = "ÚÏÏ æÇÑÏ ÔÏå ÎÇÑÌ ÇÒ ãÍÏæÏå ãí ÈÇÔÏ "

End Select
heji_adad = hooroof
End Function

Private Function Adad_Heji(ByVal adad As Integer) As String
Dim yekan As Byte
Dim dahgan As Byte
Dim sadgan As Byte
Dim behooroof As String

Dim heji(19) As String
Dim heji_dahgan(9) As String
Dim heji_sadgan(9) As String
'-------------------------------
heji(1) = "íß": heji(2) = "Ïæ": heji(3) = "Óå": heji(4) = "åÇÑ": heji(5) = "äÌ"
heji(6) = "ÔÔ": heji(7) = "åÝÊ": heji(8) = "åÔÊ": heji(9) = "äå": heji(10) = "Ïå"
heji(11) = "íÇÒÏå": heji(12) = "ÏæÇÒÏå": heji(13) = "ÓíÒÏå": heji(14) = "åÇÑÏå": heji(15) = "ÇäÒÏå"
heji(16) = "ÔÇäÒÏå": heji(17) = "åÝÏå": heji(18) = "åíÌÏå": heji(19) = "äæÒÏå"
'-------------------------------
heji_dahgan(1) = "Ïå"
heji_dahgan(2) = "ÈíÓÊ"
heji_dahgan(3) = "Óí": heji_dahgan(4) = "åá": heji_dahgan(5) = " äÌÇå"
heji_dahgan(6) = "ÔÕÊ": heji_dahgan(7) = "åÝÊÇÏ": heji_dahgan(8) = "åÔÊÇÏ"
heji_dahgan(9) = "äæÏ"
'------------------------
heji_sadgan(1) = "íßÕÏ": heji_sadgan(2) = "ÏæíÓÊ": heji_sadgan(3) = "ÓíÕÏ"
heji_sadgan(4) = "åÇÑÕÏ": heji_sadgan(5) = "ÇäÕÏ": heji_sadgan(6) = "ÔÔÕÏ"
heji_sadgan(7) = "åÝÊÕÏ": heji_sadgan(8) = "åÔÊÕÏ": heji_sadgan(9) = "äåÕÏ"
'------------------------------------------------------------------------------------------------------------
yekan = adad Mod 10
dahgan = adad Mod 100
sadgan = Int(adad / 100)
'------------------------------------------------------------------------------------------------------------
If dahgan < 20 Then
If (sadgan = 0) Then behooroof = heji(dahgan)
If (sadgan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji(dahgan)
If (yekan = 0 And dahgan = 0) Then behooroof = heji_sadgan(sadgan)
Else
dahgan = (adad Mod 100) - yekan
If (sadgan = 0 And yekan = 0) Then behooroof = heji_dahgan(dahgan / 10)
If (sadgan = 0 And yekan <> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)
If (sadgan <> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)
If (sadgan <> 0 And yekan <> 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10) + va + heji(yekan)
End If
Adad_Heji = behooroof
End Function

Private Function change_mony(ByVal Pol As Currency) As String
Dim P As String, p1 As String
Dim P2 As String, P3 As String
Dim P4 As String, Sk As String
Dim L As Byte
If Pol > 0 Then
P = Str(Pol)
Sk = Right(Trim(P), 3)
p1 = harf(Val(Trim(Sk)))
p1 = Trim(p1) & " ÑíÇá"
If Len(Trim(P)) > 3 Then
Sk = Right(Trim(P), 6)
L = Len(Trim(Sk))
Sk = Left(Trim(Sk), (L - 3))
P2 = harf(Val(Trim(Sk)))
P2 = Trim(P2) & " åÒÇÑ æ "
End If
If Len(Trim(P)) > 6 Then
Sk = Right(Trim(P), 9)
L = Len(Trim(Sk))
Sk = Left(Trim(Sk), (L - 6))
P3 = harf(Val(Trim(Sk)))
P3 = Trim(P3) & " ãíáíæä æ"
End If
If Len(Trim(P)) = 10 Then
Sk = Left(Trim(P), 1)
P4 = harf(Val(Trim(Sk)))
P4 = Trim(P4) & " ãíáíÇÑÏ æ "
End If
change_mony = Trim(P4) & Trim(P3) & Trim(P2) & Trim(p1)
End If
End Function

Private Function harf(mony2 As Long) As String
Dim S As String, S1 As String
Dim s2 As String, s3 As String
S = Trim(Str(mony2))
If Len(Trim(Str(mony2))) = 1 Then S = "00" & Trim(Str(mony2))
If Len(Trim(Str(mony2))) = 2 Then S = "0" & Trim(Str(mony2))
Select Case Left(Trim(S), 1)
Case 0
S1 = ""
Case 1
S1 = "íßÕÏ "
Case 2
S1 = "ÏæíÓÊ "
Case 3
S1 = "ÓíÕÏ"
Case 4
S1 = "åÇÑÕÏ"
Case 5
S1 = "ÇäÕÏ"
Case 6
S1 = "ÔÔÕÏ"
Case 7
S1 = "åÝÊÕÏ"
Case 8
S1 = "åÔÊÕÏ"
Case 9
S1 = "äåÕÏ"
End Select
Select Case Mid(Trim(S), 2, 1)
Case 0
s2 = ""
Case 1
Select Case Right(Trim(S), 1)
Case 0
s2 = "Ïå"
Case 1
s2 = "íÇÒÏå"
Case 2
s2 = "ÏæÇÒÏå"
Case 3
s2 = "ÓíÒÏå"
Case 4
s2 = "åÇÑÏå"
Case 5
s2 = "ÇäÒÏå"
Case 6
s2 = "ÔÇäÒÏå"
Case 7
S1 = "åÝÏå"
Case 8
S1 = "åÌÏå"
Case 9
S1 = "äæÒÏå"
End Select
Case 2
s2 = "ÈíÓÊ "
Case 3
s2 = "Óí "
Case 4
s2 = " åá"
Case 5
s2 = " äÌÇå"
Case 6
s2 = "ÔÕÊ "
Case 7
s2 = "åÝÊÇÏ"
Case 8
s2 = "åÔÊÇÏ"
Case 9
s2 = "äæÏ"
End Select
If Mid(Trim(S), 2, 1) <> 1 Then
Select Case Right(Trim(S), 1)
Case 0
s3 = ""
Case 1
s3 = "íß"
Case 2
s3 = "Ïæ"
Case 3
s3 = "Óå"
Case 4
s3 = "åÇÑ"
Case 5
s3 = "äÌ"
Case 6
s3 = "ÔÔ"
Case 7
s3 = "åÝÊ"
Case 8
s3 = "åÔÊ"
Case 9
s3 = "äå"
End Select
End If
If Trim(S1) <> "" Then S1 = S1 & " æ"
If Trim(s2) <> "" Then s2 = s2 & " æ"
If Trim(s3) <> "" Then s3 = s3 & " æ"
S = S1 & s2 & s3
If Trim(S) <> "" Then harf = Left(Trim(S), (Len(Trim(S)) - 1)) Else harf = ""
End Function

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

[karem2074]

کسی نبود کمک کنه؟

[aleas2]

سلام خسته نباشید نباشید اینم ماشین حساب از اول نوشتمش فقط اینکه بنده چون کار دارم سریع نوشتمش اگر مشکلی داشت خواهشا" خودت مشکلشو حل کن نتونستی مشکلشو همینجا بگو اگر خودم بتونم جواب میدم نتونستم دوستان جوابتو حتما" میدن تا جایی که بنده تست کردم مشکلی نداشت

به درخواست karem2074 (http://barnamenevis.org/member.php?160750-karem2074) لینک دانلود حذف شد

[karem2074]

سلام خسته نباشید نباشید اینم ماشین حساب از اول نوشتمش فقط اینکه بنده چون کار دارم سریع نوشتمش اگر مشکلی داشت خواهشا" خودت مشکلشو حل کن نتونستی مشکلشو همینجا بگو اگر خودم بتونم جواب میدم نتونستم دوستان جوابتو حتما" میدن تا جایی که بنده تست کردم مشکلی نداشت



داداش خیلی خیلی ازتون ممنونم.کار کرد.