السلام عليكم
بحثت كثيرا عن تفقيط الارقام
حتى وجدت الكود التالى وتعبت كثيرا فى استخدامه
Dim ma As String
Dim mi As String
Dim ml As String
Dim mn As String
Dim n As String
Dim b As String
Dim r As String
Dim b1 As String
Dim result As String
Dim c As String
Dim c1 As String
Dim c2 As String
Dim c3 As String
Dim c4 As String
Dim c5 As String
Dim c6 As String
Dim c7 As String
Dim c8 As String
Dim c9 As String
Dim letter1 As String
Dim letter2 As String
Dim letter3 As String
Dim letter4 As String
Dim letter5 As String
Dim letter6 As String
Dim letter7 As String
Dim letter8 As String
Dim letter9 As String
Public Function Horof(ByVal X)
ma = " جنيها "
Mi = " قرشا "
ml = " قروش "
Mn = " جنيهات "
n = Int(X)
b = Val(Right(Format(X, "000000000000.00"), 2))
R = SHorof(n)
B1 = SHorof(B)
If R <> "" And B >= 0 Then Result = R & ma & " و " & B1 & Mi & "فقط لاغير "
If r <> "" And (b <= 9 And b >= 1) Then result = r & ma & " و" & b1 & ml & " فقط لا غير "
If R = "" And B <> 0 Then Result = B1 & Mi & "فقط لاغير "
If R = "" And B = 0 Then Result = ""
If R <> "" And B = 0 Then Result = R & ma & "فقط لاغير "
Horof = Result
End Function
Private Function SHorof(ByVal X)
n = Int(X)
c = Format(n, "000000000000")
C1 = Val(Mid(c, 12, 1))
Select Case C1
Case Is = 1 : Letter1 = "واحد"
Case Is = 2 : Letter1 = "اثنان"
Case Is = 3 : Letter1 = "ثلاثة"
Case Is = 4 : Letter1 = "اربعة"
Case Is = 5 : Letter1 = "خمسة"
Case Is = 6 : Letter1 = "ستة"
Case Is = 7 : Letter1 = "سبعة"
Case Is = 8 : Letter1 = "ثمانية"
Case Is = 9 : Letter1 = "تسعة"
End Select
C2 = Val(Mid(c, 11, 1))
Select Case C2
Case Is = 1 : Letter2 = "عشر"
Case Is = 2 : Letter2 = "عشرون"
Case Is = 3 : Letter2 = "ثلاثون"
Case Is = 4 : Letter2 = "اربعون"
Case Is = 5 : Letter2 = "خمسون"
Case Is = 6 : Letter2 = "ستون"
Case Is = 7 : Letter2 = "سبعون"
Case Is = 8 : Letter2 = "ثمانون"
Case Is = 9 : Letter2 = "تسعون"
End Select
If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + " و" + Letter2
If Letter2 = "" Then Letter2 = Letter1
If C1 = 0 And C2 = 1 Then Letter2 = Letter2 + "ة"
If C1 = 1 And C2 = 1 Then Letter2 = "احدى عشر"
If C1 = 2 And C2 = 1 Then Letter2 = "اثنى عشر"
If C1 > 2 And C2 = 1 Then Letter2 = Letter1 + " " + Letter2
C3 = Val(Mid(c, 10, 1))
Select Case C3
Case Is = 1 : Letter3 = "مائة"
Case Is = 2 : Letter3 = "مئتان"
Case Is > 2 : Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + "مائة"
End Select
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
If Letter3 = "" Then Letter3 = Letter2
C4 = Val(Mid(c, 7, 3))
Select Case C4
Case Is = 1 : Letter4 = "الف"
Case Is = 2 : Letter4 = "الفان"
Case 3 To 10 : Letter4 = SHorof(C4) + " آلاف"
Case Is > 10 : Letter4 = SHorof(C4) + " الف"
End Select
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
If Letter4 = "" Then Letter4 = Letter3
C5 = Val(Mid(c, 4, 3))
Select Case C5
Case Is = 1 : Letter5 = "مليون"
Case Is = 2 : Letter5 = "مليونان"
Case 3 To 10 : Letter5 = SHorof(C5) + " ملايين"
Case Is > 10 : Letter5 = SHorof(C5) + " مليون"
End Select
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
If Letter5 = "" Then Letter5 = Letter4
C6 = Val(Mid(c, 1, 3))
Select Case C6
Case Is = 1 : Letter6 = "مليار"
Case Is = 2 : Letter6 = "ملياران"
Case Is > 2 : Letter6 = SHorof(C6) + " مليار"
End Select
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
If Letter6 = "" Then Letter6 = Letter5
SHorof = Letter6
End Function
[واقوم باستدعاء الداله حروف
فى حدث التغيير فى النص الاول لتظهر فى النص الثانى
وشكرا