تبدیل عدد به حروف در اکسس

[tanha50]

با سلام و عرض ادب خدمت اساتید بزرگوار
بنده در برنامه ام از ماژول تبدیل عدد به حروف استفاده می کنم . و می خوام اعداد اعشاری را تا دو رقم اعشار نمایش بدهم که در فیلد حروفی ، اعداد رو کامل تبدیل می کنه . لطفا اگه راهی وجود دارد که در تبدیا اعداد به حروف هم تا دو رقم اعشار رو تبدیل کنه بنده را راهنمایی کنید .
از لطف همه دوستان سپاسگزارم

[tanha50]

اساتید بزرگوار ، جناب آقای امیری عزیز
لطفا اگه راهی هست راهنمایی بفرمائید

[Abbas Amiri]

با سلام و عرض ادب خدمت اساتید بزرگوار بنده در برنامه ام از ماژول تبدیل عدد به حروف استفاده می کنم . و می خوام اعداد اعشاری را تا دو رقم اعشار نمایش بدهم که در فیلد حروفی ، اعداد رو کامل تبدیل می کنه . لطفا اگه راهی وجود دارد که در تبدیا اعداد به حروف هم تا دو رقم اعشار رو تبدیل کنه بنده را راهنمایی کنید . از لطف همه دوستان سپاسگزارم

سلام
در ماژول تبدیل خط پانزدهم را اضافه کنید
Function AbH(Number As String) 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 = ChrW(1605) & ChrW(1606) & ChrW(1601) & ChrW(1740) & " "
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 = _
" " & ChrW(1605) & ChrW(1605) & ChrW(1740) & ChrW(1586) & " " _
Else DotTxt = ""
DecimalSegment = left(DecimalSegment, 2) ' اين خط را اضافه کنيد
Select Case Len(DecimalSegment)
Case 1
DecimalTxt = " " & ChrW(1583) & ChrW(1607) & ChrW(1605)
Case 2
DecimalTxt = " " & ChrW(1589) & ChrW(1583) & ChrW(1605)
Case 3
DecimalTxt = " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605)
Case 4
DecimalTxt = " " & ChrW(1583) & ChrW(1607) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605)
Case 5
DecimalTxt = " " & ChrW(1589) & ChrW(1583) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605)
End Select
AbH = IsNegative & Horof(IntegerSegment) & DotTxt & Horof(DecimalSegment) & DecimalTxt
Exit Function
End If
AbH = Trim(IsNegative & Horof(Abs(Number)))
End Function



با تغییرات اندکی میتوان تابع فوق را جهت تنظیم نقطه اعشار و همچنین گرد کردن اعشار آن بهینه نمود.

[tanha50]

با عرض ادب خدمت جناب آقای امیری و دوستان بزرگوار
جناب آقای امیری دست شما درد نکنه مثل همیشه گل کاشتید

اما 1- چون بنده با استفاده از سایت وزین برنامه نویس به صورت تجربی اکسس را آموختم تلاشم برای بهینه سازی ماژول برای گرد کردن اعداد ناموفق بود خواهشا اگر امکان دارد زحمت این کار را برای بنده و دوستان دیگر بکشید .
2- در ویندوز 64 بیتی اعشار را نادیده گرفته و عدد نمایش داده شده را به صورت یک عدد صحیح تبدیل می کند. اگر امکان دارد توضیحاتی در این خصوص بفرمائید

قبلا از بذل محبت جنابعالی و دوستان دیگر سپاسگزارم

[Abbas Amiri]

با عرض ادب خدمت جناب آقای امیری و دوستان بزرگوار
جناب آقای امیری دست شما درد نکنه مثل همیشه گل کاشتید

اما 1- چون بنده با استفاده از سایت وزین برنامه نویس به صورت تجربی اکسس را آموختم تلاشم برای بهینه سازی ماژول برای گرد کردن اعداد ناموفق بود خواهشا اگر امکان دارد زحمت این کار را برای بنده و دوستان دیگر بکشید .
2- در ویندوز 64 بیتی اعشار را نادیده گرفته و عدد نمایش داده شده را به صورت یک عدد صحیح تبدیل می کند. اگر امکان دارد توضیحاتی در این خصوص بفرمائید

قبلا از بذل محبت جنابعالی و دوستان دیگر سپاسگزارم

سلام فانکشن اصلاح شده AbH را جایگزین کنید و فانکشن IncDecStringNumber را هم اضافه کنید.
Function AbH(Number As String, Optional DP As Integer = 5) As String
Dim IsNegative As String
Dim DotPosition As Integer
Dim IntegerSegment As String
Dim DecimalSegment As String
Dim DotTxt, DecimalTxt As String
If DP > 5 Then DP = 5
If Val(Number) >= 0 Then IsNegative = "" Else IsNegative = ChrW(1605) & ChrW(1606) & ChrW(1601) & ChrW(1740) & " "
DotPosition = InStr(1, Number, ".")
If Not (DotPosition) = 0 Then
IntegerSegment = Left(Abs(Number), DotPosition - 1)
DecimalSegment = Left(Right(Number, Len(Number) - DotPosition), 5)
Do While Len(DecimalSegment) > 0 And Right(DecimalSegment, 1) = "0"
DecimalSegment = Left(DecimalSegment, Len(DecimalSegment) - 1)

Loop
If Val(IntegerSegment) <> 0 Then DotTxt = _
" " & ChrW(1605) & ChrW(1605) & ChrW(1740) & ChrW(1586) & " " _
Else DotTxt = ""

If Len(DecimalSegment) > DP Then
DecimalSegment = Left(DecimalSegment, DP + 1)
If Val(Right(DecimalSegment, 1)) < 5 Then
DecimalSegment = Val(Left(DecimalSegment, DP))
Else
DecimalSegment = IncDecStringNumber(Left(DecimalSegment, DP), IIf(IsNegative = "", "1", "-1"))
If Len(DecimalSegment) > DP Then
Number = Val(IntegerSegment) + 1
GoTo Result
End If
End If
End If
Select Case Len(DecimalSegment)
Case 1
DecimalTxt = " " & ChrW(1583) & ChrW(1607) & ChrW(1605)
Case 2
DecimalTxt = " " & ChrW(1589) & ChrW(1583) & ChrW(1605)
Case 3
DecimalTxt = " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605)
Case 4
DecimalTxt = " " & ChrW(1583) & ChrW(1607) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605)
Case 5
DecimalTxt = " " & ChrW(1589) & ChrW(1583) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605)
End Select
AbH = IsNegative & Horof(IntegerSegment) & DotTxt & Horof(DecimalSegment) & DecimalTxt
Exit Function
End If
Result:
AbH = Trim(IsNegative & Horof(Abs(Number)))
End Function


Private Function IncDecStringNumber(strN As String, IncValue As String) As String
Dim i As Integer, Carry As Integer, Sum As Integer
Dim tmp As String
i = Len(strN)
Carry = Val(IncValue)
Do
Sum = Val(Mid(strN, i, 1)) + Carry
Carry = Sum \ 10
If Sum = -1 Then
Carry = -1
Sum = 9
Else
Sum = Sum Mod 10
End If
tmp = Sum & tmp
i = i - 1
If i = 0 Then Exit Do
Loop While Carry Or (Val(Mid(strN, i, 1)) + Carry >= 10)
tmp = Left(strN, i) & tmp
If Carry Then tmp = Carry & tmp
IncDecStringNumber = Val(tmp)
End Function


در مورد دوم ویندوز بنده هم 64 بیتی است و در فایل شما مشکلی در نمایش اعداد اعشاری نیست.
ضمنا برای صدا زدن فانکشن AbH باید آرگومان دوم آن را هم مقدار دهی کنید (در text8 برای مورد شما )=AbH([text8],2)

[tanha50]

باسلام خدمت دوستان گرامی
جناب آقای امیری از زحمتی که کشیدید بی نهایت سپاسگزارم . طبق فرمایشات جنابعالی تغییرات لازم را در ماژول اعمال نمودم در ویندوز 32 بیتی بسیار خوب عمل میکند.ولی در ویندوز 64 بیتی اعداد به شکل زیر نمایش داده می شود . لطفا اگر امکان دارد راهنمایی بفرمائید راه حلی برای رفع مشکل وجود دارد .

[Abbas Amiri]

سلام
این مورد مربوط به تنظیمات ویندوز است
در Control Panel>Format>Additional Settings>Numbers
Decimal Symbol را به دات تغییر دهید .همین طور در زبانه Currency .