فكرة مش عارف احلها

السلام عليكم

عندي فكرة

نفرض الرقم 251

قسم على 100 واحذف الباقي .... النتيجة 2..... يعني مائتان

الباقي قسمة على 10 واحذف الباقي ..... النتيجة 5 .... يعني خمسون

والباقي واحد....

النتيجة : مائتان و واحد و خمسون

والسلام عليكم

اخى العزيز ....

...............

يمكنك تحويل الارقام الى حروف عن طريق عدة خطوات

1- عرف فى ملف تكست الارقام

1و2و3و4و5و6و7و8و9و0 مثلا " واحد و اثنان ...... "

2- قم بادخال الرقم المرات تحويلة إلى array

a(5)

3- عرف الخانة الاولى بلاحاد و الثانية بالعشرات و .......

4- ابدا عملية البحث و التحويل --------- ربط الارقام بمسمياتها من الحروف

5- قم باضافى

6-+

if a(0) = "" null

if a(1) = "' عشر

if a(2) = ""مائة

........ الف

.....

... ect

ارجو ان تكون فهمت ما اقصد .......... تفاعل مع الفكرة و هيئها كما يحلو لك ...

اين يوجد زر اضافة ملف مرفق

الكود جاهز عندى بس مش عارف ارسله ازاى

كمان ما معنى كلمة تنبيه الموجوده تحت اسمى على اليمين

فقط قم بنسخ هذه الدالة فى موديول جديد أو موديول موجود لديك أو حتى فى الإعلان الخاص بالنموذج

واستخدم الدالة فى تحويل الأرقام إلى كلمات وأيضا بها ميزة تحديد العملة الرئيسية والعملة الفرعية مثل جنيه وقرش أو ريال وهللة ... إلخ

Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String
  Dim MyArry1(0 To 9) As String
  Dim MyArry2(0 To 9) As String
  Dim MyArry3(0 To 9) As String
  Dim MyNo, MyFraction, MyHun, MyThou As String
  Dim MyMillion, Mybillion As String
  Dim My1, My10, My11, My12, My100 As String
  Dim MyAnd As String
  Dim GetNo, GetTxt As String
  Dim ReMark As String
  Dim RdNo As String
  Dim i As Integer

  Select Case TheNo
    Case Is > 999999999999.99
      NoToTxt = "رقم كبير جدا"
      Exit Function
    Case 0
      NoToTxt = "صفر"
      Exit Function
    Case Is < 0
      NoToTxt = "رقم أقل من صفر"
      Exit Function
    Case Else
      MyAnd = " و"
      MyArry1(0) = ""
      MyArry1(1) = "مائة"
      MyArry1(2) = "مائتان"
      MyArry1(3) = "ثلاثمائة"
      MyArry1(4) = "أربعمائة"
      MyArry1(5) = "خمسمائة"
      MyArry1(6) = "ستمائة"
      MyArry1(7) = "سبعمائة"
      MyArry1(8) = "ثمانمائة"
      MyArry1(9) = "تسعمائة"
    
      MyArry2(0) = ""
      MyArry2(1) = " عشر"
      MyArry2(2) = "عشرون"
      MyArry2(3) = "ثلاثون"
      MyArry2(4) = "أربعون"
      MyArry2(5) = "خمسون"
      MyArry2(6) = "ستون"
      MyArry2(7) = "سبعون"
      MyArry2(8) = "ثمانون"
      MyArry2(9) = "تسعون"
    
      MyArry3(0) = ""
      MyArry3(1) = "واحد"
      MyArry3(2) = "اثنان"
      MyArry3(3) = "ثلاثة"
      MyArry3(4) = "أربعة"
      MyArry3(5) = "خمسة"
      MyArry3(6) = "ستة"
      MyArry3(7) = "سبعة"
      MyArry3(8) = "ثمانية"
      MyArry3(9) = "تسعة"
      
      'تحويل الرقم إلى الشكل المناسب
      GetNo = Format(TheNo, "000000000000.00")
  End Select

  i = 0
  Do While i < 15
    If i < 12 Then
      MyNo = Mid$(GetNo, i + 1, 3)
    Else
      MyNo = "0" + Mid$(GetNo, i + 2, 2)
    End If
    '-----------------------------------------
    If (Mid$(MyNo, 1, 3)) > 0 Then
      RdNo = Mid$(MyNo, 1, 1)
      My100 = MyArry1(RdNo)
      RdNo = Mid$(MyNo, 3, 1)
      My1 = MyArry3(RdNo)
      RdNo = Mid$(MyNo, 2, 1)
      My10 = MyArry2(RdNo)
      If Mid$(MyNo, 2, 2) = 11 Then
        My11 = "إحدى عشر"
      End If
      If Mid$(MyNo, 2, 2) = 12 Then
        My12 = "إثنى عشر"
      End If
      If Mid$(MyNo, 2, 2) = 10 Then
        My10 = "عشرة"
      End If
      If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then
        My100 = My100 + MyAnd
      End If
      If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then
        My1 = My1 + MyAnd
      End If
      GetTxt = My100 + My1 + My10
      If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then
        GetTxt = My100 + My11
        If ((Mid$(MyNo, 1, 1)) = 0) Then
          GetTxt = My11
        End If
      End If
      If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then
        GetTxt = My100 + My12
        If ((Mid$(MyNo, 1, 1)) = 0) Then
          GetTxt = My12
        End If
      End If
      If (i = 0) And (GetTxt <> "") Then
        If ((Mid$(MyNo, 1, 3)) > 10) Then
          Mybillion = GetTxt + " مليار"
        Else
          Mybillion = GetTxt + " مليارات"
          If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار"
          If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران"
        End If
      End If
      If (i = 3) And (GetTxt <> "") Then
        If ((Mid$(MyNo, 1, 3)) > 10) Then
          MyMillion = GetTxt + " مليون"
        Else
          MyMillion = GetTxt + " ملايين"
          If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون"
          If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان"
        End If
      End If
      If (i = 6) And (GetTxt <> "") Then
        If ((Mid$(MyNo, 1, 3)) > 10) Then
          MyThou = GetTxt + " ألف"
        Else
          MyThou = GetTxt + " آلاف"
          If ((Mid$(MyNo, 3, 1)) = 1) Then
            MyThou = " ألف"
          End If
          If ((Mid$(MyNo, 3, 1)) = 2) Then
            MyThou = " ألفان"
          End If
        End If
      End If
      If (i = 9) And (GetTxt <> "") Then
        MyHun = GetTxt
      End If
      If (i = 12) And (GetTxt <> "") Then
        MyFraction = GetTxt
      End If
    End If
    '-----------------------------------------
    i = i + 3
  Loop

  If (Mybillion <> "") Then
    If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
      Mybillion = Mybillion + MyAnd
    End If
  End If

  If (MyMillion <> "") Then
    If (MyThou <> "") Or (MyHun <> "") Then
      MyMillion = MyMillion + MyAnd
    End If
  End If

  If (MyThou <> "") Then
    If (MyHun <> "") Then
      MyThou = MyThou + MyAnd
    End If
  End If

  If MyFraction <> "" Then
    If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
      NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
    Else
      NoToTxt = ReMark + MyFraction + " " + MySubCur
    End If
  Else
    NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
  End If
End Function

منقول عن زميل فاضل فى هذا المنتدى ولكن أعتذر لعدم تذكر الاسم

مرحبا يا شباب

بالفعل انا أشكركم على اهتمامكم بي والحمد الله لقد وصلت الى الحل والفضل بعد الله الاخ ابو الحجاج

أما بالنسبة لارسال ملف مرفق فوالله انا لا اعلم خاصة بعد التعديل الذي حدث على المنتدى ...

وشكرا