قبلا دو روش برای تبدیل عدد به حروف در اکسل معرفی کرده ایم و حالا نوبت به روشهای مختلف تبدیل عدد به حروف در اکسس رسیده است. قبل از هرچیز توجه داشته باشید که اگر از ماژولهای تاریخ شمسی اکسس استفاده میکنید ، نیازی به قرار دادن کدها ندارید ، چون این کدها در آن ماژول وجود دارد.
زمان مورد نیاز: 10 دقیقه
کپی کردن کدهای تبدیل عدد به حروف
کدهای در ادامه آمده است را کپی کنید .
فایل اکسس خود را باز کرده و با زدن کلیدهای Alt+F11 وارد کد نویسی شوید.
در قسمت ماژولها کلیک راست کرده و Insert Module را بزنید.
کدهای کپی شده را در این قسمت پیست کنید .
برای تبدیل اعداد انگلیسی به حروف هم میتوانید از این آموزش استفاده کنید.
استفاده از تابع HOROF
حالا به محیط اکسس برگردید.
فرقی نمی کند که در محیط فرم باشید یا گزارش یا کوئری.
کافیست از تابع HOROF استفاده کنید . و مقدار عددی را به عنوان آرگومان به آن بدهید.
با اقدامات بالا تبدیل عدد به حروف در اکسس به راحتی انجام خواهد شد.
تولید:
- تکمیل و توسعه توسط آفیس باز
ابزارها:
- کدهایی که در همین مطلب قرار گرفته است
اطلاعات تکمیلی: این کدها به دلیل استفاده از کدهای استاندارد برای حروف فارسی مشکل به هم ریختگی نخواهند داشت تا به این لحظه بهترین روش برای تبدیل عدد به حروف در اکسس می باشد.
دانلود کدهای تبدیل عدد به حروف در اکسس
Function Horof(eNo As Double) As String
Dim eFixed As String, eDecimal As String
Dim sResult As String
Dim LTZ As Boolean
If eNo < 0 Then
LTZ = True
eNo = -eNo
Else
LTZ = False
End If
If (eNo < 1 And eNo > 0 And Len(CStr(eNo)) > 8) Or InStr(1, Trim(Str(eNo)), "E") > 0 Then
If LTZ Then
Horof = "-##########"
Else
Horof = "##########"
End If
Exit Function
End If
'return fixed value of given number as string
eFixed = Fix(eNo)
'تبدیل عدد به حروف در اکسس
'if this number has some decimals
If (Len(CStr(eNo)) - Len(eFixed)) Then
'get it as a string, Example: return `125` for `12.125`
If eFixed = 0 Then
eDecimal = Mid(CStr(eNo), Len(eFixed) + 2)
Else
eDecimal = Left(Mid(CStr(eNo), Len(eFixed) + 2), 6)
End If
'return fixed part as text
sResult = Horof_fix(eFixed) + " " & ChrW(1605) & ChrW(1605) & ChrW(1740) & ChrW(1586) & " "
'if decimal section is `5` then use `äíã` Instead of `äÌ Ïåã`
'this is optional, u can remove it if u like
If eDecimal = 5 Then
sResult = sResult + " " + ChrW(1606) & ChrW(1740) & ChrW(1605)
Else
'convert the decimal part of number to text
sResult = sResult + " " + Horof_fix(eDecimal)
'add extra suffix at end of string, depending to number of decimal places
sResult = sResult + " " + Choose(Len(eDecimal), ChrW(1583) & ChrW(1607) & ChrW(1605), ChrW(1589) & ChrW(1583) & ChrW(1605), _
ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605), ChrW(1583) & ChrW(1607) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605), _
ChrW(1589) & ChrW(1583) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & ChrW(1605), ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1608) & ChrW(1606) & ChrW(1740) & ChrW(1608) & ChrW(1605)) ', _
....
End If
Else
'if this number is originally an integer then convert it using normal method
sResult = Horof_fix(eNo)
End If
'return the result. ;)
Horof = sResult
If LTZ Then Horof = " " & ChrW(1605) & ChrW(1606) & ChrW(1601) & ChrW(1740) & Horof
If Horof = ChrW(1605) & ChrW(1606) & ChrW(1601) & ChrW(1740) & "##########" Then Horof = "##########"
If eNo = 0 Then Horof = ChrW(1589) & ChrW(1601) & ChrW(1585)
End Function
'تبدیل عدد به حروف در اکسس
Function Horof_fix(ByVal Number As Double) As String
If Number = 0 Then
Horof_fix = ChrW(1589) & ChrW(1601) & ChrW(1585)
End If
Dim Flag As Boolean
Dim s As String
Dim I, L As Byte
Dim K(1 To 5) As Double
s = Trim(Str(Number))
L = Len(s)
If L > 15 Then
Horof_fix = "##########"
Exit Function
End If
For I = 1 To 15 - L
s = "0" & s
Next I
For I = 1 To Int((L / 3) + 0.99)
K(5 - I + 1) = Val(Mid(s, 3 * (5 - I) + 1, 3))
Next I
Flag = False
s = ""
For I = 1 To 5
If K(I) <> 0 Then
Select Case I
Case 1
s = s & Three(K(I)) & " " & ChrW(1578) & ChrW(1585) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1608) & ChrW(1606) & " "
Flag = True
Case 2
s = s & IIf(Flag = True, ChrW(1608), "") & Three(K(I)) & " " & ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1575) & ChrW(1585) & ChrW(1583) & " "
Flag = True
Case 3
s = s & IIf(Flag = True, ChrW(1608), "") & Three(K(I)) & " " & ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1608) & ChrW(1606) & " "
Flag = True
Case 4
s = s & IIf(Flag = True, ChrW(1608), "") & Three(K(I)) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & " "
Flag = True
Case 5
s = s & IIf(Flag = True, ChrW(1608), "") & Three(K(I))
End Select
End If
Next I
Horof_fix = s
End Function
'تبدیل عدد به حروف در اکسس Officebaz.ir
Function Three(ByVal Number As Integer) As String
Dim s As String
Dim I, L As Long
Dim h(1 To 3) As Byte
Dim Flag As Boolean
L = Len(Trim(Str(Abs(Number))))
If Number = 0 Then
Three = ""
Exit Function
End If
If Number = 100 Then
Three = ChrW(1740) & ChrW(1705) & ChrW(1589) & ChrW(1583)
Exit Function
End If
If L = 2 Then h(1) = 0
If L = 1 Then
h(1) = 0
h(2) = 0
End If
For I = 1 To L
h(3 - I + 1) = Mid(Trim(Str(Abs(Number))), L - I + 1, 1)
Next I
Select Case h(1)
Case 1
s = " " & ChrW(1740) & ChrW(1705) & ChrW(1589) & ChrW(1583)
Case 2
s = " " & ChrW(1583) & ChrW(1608) & ChrW(1740) & ChrW(1587) & ChrW(1578)
Case 3
s = " " & ChrW(1587) & ChrW(1740) & ChrW(1589) & ChrW(1583)
Case 4
s = " " & ChrW(1670) & ChrW(1607) & ChrW(1575) & ChrW(1585) & ChrW(1589) & ChrW(1583)
Case 5
s = " " & ChrW(1662) & ChrW(1575) & ChrW(1606) & ChrW(1589) & ChrW(1583)
Case 6
s = " " & ChrW(1588) & ChrW(1588) & ChrW(1589) & ChrW(1583)
Case 7
s = " " & ChrW(1607) & ChrW(1601) & ChrW(1578) & ChrW(1589) & ChrW(1583)
Case 8
s = " " & ChrW(1607) & ChrW(1588) & ChrW(1578) & ChrW(1589) & ChrW(1583)
Case 9
s = " " & ChrW(1606) & ChrW(1607) & ChrW(1589) & ChrW(1583)
End Select
Select Case h(2)
Case 1
Select Case h(3)
Case 0
s = s & " " & ChrW(1608) & " " & ChrW(1583) & ChrW(1607)
Case 1
s = s & " " & ChrW(1608) & " " & ChrW(1740) & ChrW(1575) & ChrW(1586) & ChrW(1583) & ChrW(1607)
Case 2
s = s & " " & ChrW(1608) & " " & ChrW(1583) & ChrW(1608) & ChrW(1575) & ChrW(1586) & ChrW(1583) & ChrW(1607)
Case 3
s = s & " " & ChrW(1608) & " " & ChrW(1587) & ChrW(1740) & ChrW(1586) & ChrW(1583) & ChrW(1607)
Case 4
s = s & " " & ChrW(1608) & " " & ChrW(1670) & ChrW(1607) & ChrW(1575) & ChrW(1585) & ChrW(1583) & ChrW(1607)
Case 5
s = s & " " & ChrW(1608) & " " & ChrW(1662) & ChrW(1575) & ChrW(1606) & ChrW(1586) & ChrW(1583) & ChrW(1607)
Case 6
s = s & " " & ChrW(1608) & " " & ChrW(1588) & ChrW(1575) & ChrW(1606) & ChrW(1586) & ChrW(1583) & ChrW(1607)
Case 7
s = s & " " & ChrW(1608) & " " & ChrW(1607) & ChrW(1601) & ChrW(1583) & ChrW(1607)
Case 8
s = s & " " & ChrW(1608) & " " & ChrW(1607) & ChrW(1580) & ChrW(1583) & ChrW(1607)
Case 9
s = s & " " & ChrW(1608) & " " & ChrW(1606) & ChrW(1608) & ChrW(1586) & ChrW(1583) & ChrW(1607)
End Select
Case 2
s = s & " " & ChrW(1608) & " " & ChrW(1576) & ChrW(1740) & ChrW(1587) & ChrW(1578)
Case 3
s = s & " " & ChrW(1608) & " " & ChrW(1587) & ChrW(1740)
Case 4
s = s & " " & ChrW(1608) & " " & ChrW(1670) & ChrW(1607) & ChrW(1604)
Case 5
s = s & " " & ChrW(1608) & " " & ChrW(1662) & ChrW(1606) & ChrW(1580) & ChrW(1575) & ChrW(1607)
Case 6
s = s & " " & ChrW(1608) & " " & ChrW(1588) & ChrW(1589) & ChrW(1578)
Case 7
s = s & " " & ChrW(1608) & " " & ChrW(1607) & ChrW(1601) & ChrW(1578) & ChrW(1575) & ChrW(1583)
Case 8
s = s & " " & ChrW(1608) & " " & ChrW(1607) & ChrW(1588) & ChrW(1578) & ChrW(1575) & ChrW(1583)
Case 9
s = s & " " & ChrW(1608) & " " & ChrW(1606) & ChrW(1608) & ChrW(1583)
End Select
'تبدیل عدد به حروف در اکسس
If h(2) <> 1 Then
Select Case h(3)
Case 1
s = s & " " & ChrW(1608) & " " & ChrW(1740) & ChrW(1705)
Case 2
s = s & " " & ChrW(1608) & " " & ChrW(1583) & ChrW(1608)
Case 3
s = s & " " & ChrW(1608) & " " & ChrW(1587) & ChrW(1607)
Case 4
s = s & " " & ChrW(1608) & " " & ChrW(1670) & ChrW(1607) & ChrW(1575) & ChrW(1585)
Case 5
s = s & " " & ChrW(1608) & " " & ChrW(1662) & ChrW(1606) & ChrW(1580)
Case 6
s = s & " " & ChrW(1608) & " " & ChrW(1588) & ChrW(1588)
Case 7
s = s & " " & ChrW(1608) & " " & ChrW(1607) & ChrW(1601) & ChrW(1578)
Case 8
s = s & " " & ChrW(1608) & " " & ChrW(1607) & ChrW(1588) & ChrW(1578)
Case 9
s = s & " " & ChrW(1608) & " " & ChrW(1606) & ChrW(1607)
End Select
End If
s = IIf(L < 3, Right(s, Len(s) - 3), s)
Three = s
End Function
'تبدیل عدد به حروف در اکسساگر شما روش یا راه مناسب تری برای تبدیل عدد به حروف در اکسس سراغ دارید و یا مشکلی در استفاده از این ماژول داشتید حتما در نظرات اعلام نمائید.
آیا این روش با اعداد اعشاری مشکلی ندارد؟
خیر هیچ مشکلی با اعداد اعشاری نداشته و به راحتی آنها را به حروف فارسی تبدیل می کند .
چرا برای من ارور Conflict می دهد؟
اگر همزمان دارید از ماژولهای شمسی از این توابع استفاده می کنید بدانید که امکانات تبدیل عدد به حروف فارسی در اکسس با توابع شمسی آفیس باز همپوشانی داشته و باعث بروز خطا می شود و در واقع وقتی شما توابع ماژول شمسی آفیس باز را در فایل اکسس خود دارد دیگر نیازی به اضافه کردن این کدها نیست و می توانید بدین این کدها از تبدیل عدد به حروف فارسی بهره ببرید.
1 Comment
Join the discussion and tell us your opinion.
خیلی عالی