درخواست ماژول تبديل اعداد به حروف

[ARData]

سلام

از دوستان اگه کسي اين ماژول رو داره لطفا ارسال کنه ممنون ميشم .
جستجو کردم و نيافتم .

[dadsara]

سلام
در کدهای ارائه شده از طرف آقای آزادی این مورد موجود می باشد

[payman_xxp]

سلام

از دوستان اگه کسي اين ماژول رو داره لطفا ارسال کنه ممنون ميشم .
جستجو کردم و نيافتم .

سلام
این ماژول رو از همین بچه های سایت گرفتم( حیف یادم نیست، دستش درد نکنه):
Attribute VB_Name = "Addad_b_Horof"
Global AlphaNumeric1(0 To 19) As String
Global AlphaNumeric2(1 To 9) As String
Global AlphaNumeric3(1 To 9) As String
Function AbH(Number As String)

Dim IsNegative As String
Dim DotPosition As Integer
Dim IntegerSegment As String
Dim DecimalSegment As String
Dim DotTxt, DecimalTxt As String

If Val(Number) > 0 Then IsNegative = "" Else IsNegative = "منفي "
DotPosition = InStr(1, Number, ".")

If Not (DotPosition) = 0 Then
IntegerSegment = Left(Abs(Number), DotPosition - 1)
DecimalSegment = Left(Right(Number, Len(Number) - DotPosition), 5)

If Val(IntegerSegment) <> 0 Then DotTxt = " مميز " Else DotTxt = ""

Select Case Len(DecimalSegment)

Case 1
DecimalTxt = " دهم "
Case 2
DecimalTxt = " صدم "
Case 3
DecimalTxt = " هزارم "
Case 4
DecimalTxt = " ده هزارم "
Case 5
DecimalTxt = " صد هزارم "

End Select


AbH = IsNegative & Horof(IntegerSegment) & DotTxt & Horof(DecimalSegment) & DecimalTxt


Exit Function

End If



AbH = IsNegative & Horof(Abs(Number))


End Function

Sub alphaset()
Dim i%
AlphaNumeric1(0) = ""
AlphaNumeric1(1) = "يك"
AlphaNumeric1(2) = "دو"
AlphaNumeric1(3) = "سه"
AlphaNumeric1(4) = "چهار"
AlphaNumeric1(5) = "پنج"
AlphaNumeric1(6) = "شش"
AlphaNumeric1(7) = "هفت"
AlphaNumeric1(8) = "هشت"
AlphaNumeric1(9) = "نه"
AlphaNumeric1(10) = "ده"
AlphaNumeric1(11) = "يازده"
AlphaNumeric1(12) = "دوازده"
AlphaNumeric1(13) = "سيزده"
AlphaNumeric1(14) = "چهارده"
AlphaNumeric1(15) = "پانزده"
AlphaNumeric1(16) = "شانزده"
AlphaNumeric1(17) = "هفده"
AlphaNumeric1(18) = "هيجده"
AlphaNumeric1(19) = "نوزده"


AlphaNumeric2(1) = "ده"
AlphaNumeric2(2) = "بيست"
AlphaNumeric2(3) = "سي"
AlphaNumeric2(4) = "چهل"
AlphaNumeric2(5) = "پنجاه"
AlphaNumeric2(6) = "شصت"
AlphaNumeric2(7) = "هفتاد"
AlphaNumeric2(8) = "هشتاد"
AlphaNumeric2(9) = "نود"

AlphaNumeric3(1) = "يكصد"
AlphaNumeric3(2) = "دويست"
AlphaNumeric3(3) = "سيصد"
AlphaNumeric3(4) = "چهارصد"
AlphaNumeric3(5) = "پانصد"
AlphaNumeric3(6) = "ششصد"
AlphaNumeric3(7) = "هفتصد"
AlphaNumeric3(8) = "هشتصد"
AlphaNumeric3(9) = "نهصد"


End Sub


Function Horof(Number As String) As String
alphaset
Dim No As Currency, n As String

On Error GoTo Horoferror

No = CCur(Number)
n = CStr(No)

Select Case Len(n)
Case 1 To 3:
If n < 20 Then
Horof = AlphaNumeric1(n)
ElseIf n < 100 Then
If n Mod 10 = 0 Then
Horof = AlphaNumeric2(n \ 10)
Else
Horof = AlphaNumeric2(n \ 10) & " و " & Horof(n Mod 10)
End If
ElseIf n < 1000 Then
If n Mod 100 = 0 Then
Horof = AlphaNumeric3(n \ 100)
Else
Horof = AlphaNumeric3(n \ 100) & " و " & Horof(n Mod 100)
End If

End If
Case 4 To 6:
If (Right(n, 3)) = 0 Then
Horof = Horof(Left(n, Len(n) - 3)) & " هزار "
Else
Horof = Horof(Left(n, Len(n) - 3)) & " هزار و " & Horof(Right(n, 3))
End If
Case 7 To 9:
If (Right(n, 6)) = 0 Then
Horof = Horof(Left(n, Len(n) - 6)) & " ميليون "
Else
Horof = Horof(Left(n, Len(n) - 6)) & " ميليون و " & Horof(Right(n, 6))
End If
Case Else:
If (Right(n, 9)) = 0 Then
Horof = Horof(Left(n, Len(n) - 9)) & " ميليارد "
Else
Horof = Horof(Left(n, Len(n) - 9)) & " ميليارد و " & Horof(Right(n, 9))
End If

End Select

Exit Function
Horoferror:
Horof = "#Error"
End Function
موفق باشید.

[ARData]

مرسي از زحمت شما

[majid_labbeiky]

چطوري از اين ماژول استفاده كنيم ؟

[fazl11]

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

[majid_labbeiky]

ممنون ميشم بگي

ميخواستم توي فرم كه مبلغ فاكتورو محاسبه ميكنه ، مبلغ به صورت حرفي هم نوشته بشه و توي گزارش همين طور

[payman_xxp]

ممنون ميشم بگي

ميخواستم توي فرم كه مبلغ فاكتورو محاسبه ميكنه ، مبلغ به صورت حرفي هم نوشته بشه و توي گزارش همين طور

سلام
بعد از محاسبه مبلغ فاکتور و نمایش اون در یه تکست باکس، مقدار این تکست باکس رو به تابع تبدیل پاس بده و مقدار برگشتی رو در یه تکس باکس یا لیبل نشون بده.
موفق باشید.

[علم دار]

سلام
بعد از محاسبه مبلغ فاکتور و نمایش اون در یه تکست باکس، مقدار این تکست باکس رو به تابع تبدیل پاس بده و مقدار برگشتی رو در یه تکس باکس یا لیبل نشون بده.
موفق باشید.

سلام و خسته نباشید :
بعداز محاسبه و نمایش آن در یک تکست باکس در هنگام استفاده از تابع مورد نظر و برای نمایش مقدار حرفی اعداد مرتب با پیام ERROR مواجه میشوم اگر زحمتی نیست نحوه و فرمت استفاده از دستور را نیز نشان دهید

[AbbasSediqi]

دوست عزیز اول از همه باید Format تکس باکس رو General Number قرار بدی
یا اینکه تابه رو به این شکل استفاده کنی
ABH(val(Text0))
یا حق