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) 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 = ""
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 = WorksheetFunction.Trim(IsNegative & Horof(Abs(Number)))
End Function
Sub alphaset()
Dim i%
AlphaNumeric1(0) = ChrW(1589) & ChrW(1601) & ChrW(1585)
AlphaNumeric1(1) = ChrW(1740) & ChrW(1705)
AlphaNumeric1(2) = ChrW(1583) & ChrW(1608)
AlphaNumeric1(3) = ChrW(1587) & ChrW(1607)
AlphaNumeric1(4) = ChrW(1670) & ChrW(1607) & ChrW(1575) & ChrW(1585)
AlphaNumeric1(5) = ChrW(1662) & ChrW(1606) & ChrW(1580)
AlphaNumeric1(6) = ChrW(1588) & ChrW(1588)
AlphaNumeric1(7) = ChrW(1607) & ChrW(1601) & ChrW(1578)
AlphaNumeric1(8) = ChrW(1607) & ChrW(1588) & ChrW(1578)
AlphaNumeric1(9) = ChrW(1606) & ChrW(1607)
AlphaNumeric1(10) = ChrW(1583) & ChrW(1607)
AlphaNumeric1(11) = ChrW(1740) & ChrW(1575) & ChrW(1586) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(12) = ChrW(1583) & ChrW(1608) & ChrW(1575) & ChrW(1586) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(13) = ChrW(1587) & ChrW(1740) & ChrW(1586) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(14) = ChrW(1670) & ChrW(1607) & ChrW(1575) & ChrW(1585) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(15) = ChrW(1662) & ChrW(1575) & ChrW(1606) & ChrW(1586) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(16) = ChrW(1588) & ChrW(1575) & ChrW(1606) & ChrW(1586) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(17) = ChrW(1607) & ChrW(1601) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(18) = ChrW(1607) & ChrW(1740) & ChrW(1580) & ChrW(1583) & ChrW(1607)
AlphaNumeric1(19) = ChrW(1606) & ChrW(1608) & ChrW(1586) & ChrW(1583) & ChrW(1607)
AlphaNumeric2(1) = ChrW(1583) & ChrW(1607)
AlphaNumeric2(2) = ChrW(1576) & ChrW(1740) & ChrW(1587) & ChrW(1578)
AlphaNumeric2(3) = ChrW(1587) & ChrW(1740)
AlphaNumeric2(4) = ChrW(1670) & ChrW(1607) & ChrW(1604)
AlphaNumeric2(5) = ChrW(1662) & ChrW(1606) & ChrW(1580) & ChrW(1575) & ChrW(1607)
AlphaNumeric2(6) = ChrW(1588) & ChrW(1589) & ChrW(1578)
AlphaNumeric2(7) = ChrW(1607) & ChrW(1601) & ChrW(1578) & ChrW(1575) & ChrW(1583)
AlphaNumeric2(8) = ChrW(1607) & ChrW(1588) & ChrW(1578) & ChrW(1575) & ChrW(1583)
AlphaNumeric2(9) = ChrW(1606) & ChrW(1608) & ChrW(1583)
AlphaNumeric3(1) = ChrW(1740) & ChrW(1705) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(2) = ChrW(1583) & ChrW(1608) & ChrW(1740) & ChrW(1587) & ChrW(1578)
AlphaNumeric3(3) = ChrW(1587) & ChrW(1740) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(4) = ChrW(1670) & ChrW(1607) & ChrW(1575) & ChrW(1585) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(5) = ChrW(1662) & ChrW(1575) & ChrW(1606) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(6) = ChrW(1588) & ChrW(1588) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(7) = ChrW(1607) & ChrW(1601) & ChrW(1578) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(8) = ChrW(1607) & ChrW(1588) & ChrW(1578) & ChrW(1589) & ChrW(1583)
AlphaNumeric3(9) = ChrW(1606) & ChrW(1607) & ChrW(1589) & ChrW(1583)
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) & " " & ChrW(1608) & " " & 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) & " " & ChrW(1608) & " " & 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)) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & " "
Else
Horof = Horof(Left(N, Len(N) - 3)) & " " & ChrW(1607) & ChrW(1586) & ChrW(1575) & ChrW(1585) & " " & ChrW(1608) & " " & Horof(Right(N, 3))
End If
Case 7 To 9:
If (Right(N, 6)) = 0 Then
Horof = Horof(Left(N, Len(N) - 6)) & " " & ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1608) & ChrW(1606) & " "
Else
Horof = Horof(Left(N, Len(N) - 6)) & " " & ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1608) & ChrW(1606) & " " & ChrW(1608) & " " & Horof(Right(N, 6))
End If
Case Else:
If (Right(N, 9)) = 0 Then
Horof = Horof(Left(N, Len(N) - 9)) & " " & ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1575) & ChrW(1585) & ChrW(1583) & " "
Else
Horof = Horof(Left(N, Len(N) - 9)) & " " & ChrW(1605) & ChrW(1740) & ChrW(1604) & ChrW(1740) & ChrW(1575) & ChrW(1585) & ChrW(1583) & " " & ChrW(1608) & " " & Horof(Right(N, 9))
End If
End Select
Exit Function
Horoferror:
Horof = "#Error"
End Function
کامنت