ارجو المساعدة في الأكسل في تحويل الرقم إلى حرف

[tnt707]

حياتي

أول شيء شكراً لكم على كل مجهوداتكم ووفقكم الله لعمل كل خير

ارجو منكم المساعدة في الموضوع التالي

ان أريد استحدام برنامج الأكسل ليحول الرقم إلى حرف في اللغة العربية

يعني اذا كتب في خانة 1 اريده أن يظهر في الخانة التي فوقه أو بجانبه حرف أ

و 2 يظهر ب

و 3 يظهر خ

و هلم جراً

يعني : 1=أ

2=ب

3=ت

4=ث

5=ج

6=ح

7=خ

8=د

9=ذ

10=ر

11=ز

12=س

13=ش

14=ص

15=ض

16=ط

17=ظ

18=ع

19=غ

20=ف

21=ق

22=ك

23=ل

24=م

25=ن

26=هـ

27=و

28=ي

و جزاكم الله كل خير

[abo omar]

أخى العزيز tnt

حاولت ارفع هذا الملف وفيه الاجابه ان شاء الله

بإستخدام معادلة ( if) تتمكن من تحقيق الشرط المطلوب

بحيث فى حالة كتابة اى رقم من 1 الى 28 يظهر لك الحرف المقابل باللغه العربيه

بمعنى تكتب (1) فى اى خانه يظهر لك الحرف أ وهكذا

ولكن سامحنى فلطول المعادله اقتصرت على اربع احرف فقط

ولكن بنفس المعادله ممكن حضرتك تكمل حتى العدد 28

ولو حضرتك عايزنى أكملها للأخر ولو حضرتك لم تستطيع فأنا تحت امرك

[abo omar]

وهذا هو رابط الموضوع

http://www.4shared.com/file/228263461/7db00505/_2___.html

[tnt707]

أكثر الله خيرك يا أخي و شكراً جزيلاً

[Maher_mla]

تفضل اخي هذا كود معدل من قبلي ومجرب 100%

ومرفق معه مثال على ذالك

'NombreToArabe(Cellule)

'Conversion Automatique de Chiffre en Lettres Arabes

'Date: 01 juillet 2003

'Bou-Saada

Function lireCentaine(ByVal Montant As Double) As String

Dim ChiffreLettre

Dim Centaine As Double

Dim Dizaine As Double

Dim T As String

Dim Chaine As String

ChiffreLettre = Array("æÇÍÏ ", "ÇËäÇä ", "ËáÇËÉ ", "ÃÑÈÚÉ ", "ÎãÓÉ ", "ÓÊÉ ", "ÓÈÚÉ ", "ËãÇäíÉ ", "ÊÓÚÉ ", "ÚÔÑÉ ", "ÅÍÏì ÚÔÑ ", "ÇËäí ÚÔÑ ", "ËáÇËÉ ÚÔÑ ", "ÃÑÈÚÉ ÚÔÑ ", "ÎãÓÉ ÚÔÑ ", "ÓÊÉ ÚÔÑ ", "ÓÈÚÉ ÚÔÑ ", "ËãÇäíÉ ÚÔÑ ", "ÊÓÚÉ ÚÔÑ ")

Centaine = Int(Montant / 100)

Select Case Centaine

Case 0

    Chaine = ""

Case 1

        Chaine = "ãÆÉ"

Case 2

        Chaine = "ãÆÊÇä "

Case 3

        Chaine = "ËáÇË ãÆÉ"

Case 4

        Chaine = "ÃÑÈÚ ãÆÉ"

Case 5

        Chaine = "ÎãÓ ãÆÉ"

Case 6

        Chaine = "ÓÊ ãÆÉ"

Case 7

        Chaine = "ÓÈÚ ãÆÉ"

Case 8

        Chaine = "ËãÇä ãÆÉ"

Case 9

        Chaine = "ÊÓÚ ãÆÉ"

End Select

Dizaine = Modulo(Montant, 100)

Select Case Dizaine

    Case 0

        T = ""

    Case 1 To 19

        T = ChiffreLettre(Dizaine - 1)

    Case 20

        T = "ÚÔÑæä "

    Case 21 To 29

        T = ChiffreLettre(Dizaine - 21) & "æÚÔÑæä "

    Case 30

        T = "臂辊 "

    Case 31 To 39

        T = ChiffreLettre(Dizaine - 31) & "æËáÇËæä "

    Case 40

        T = "ÃÑÈÚæä "

    Case 41 To 49

        T = ChiffreLettre(Dizaine - 41) & "æÃÑÈÚæä "

    Case 50

        T = "ÎãÓæä "

    Case 51 To 59

        T = ChiffreLettre(Dizaine - 51) & "æÎãÓæä "

    Case 60

        T = "ÓÊæä "

    Case 61 To 69

        T = ChiffreLettre(Dizaine - 61) & "æÓÊæä "

    Case 70

        T = "ÓÈÚæä "

    Case 71 To 79

        T = ChiffreLettre(Dizaine - 71) & "æÓÈÚæä "

    Case 80

        T = "ËãÇäæä "

    Case 81 To 89

        T = ChiffreLettre(Dizaine - 81) & "æËãÇäæä "

    Case 90

        T = " ÊÓÚæä "

    Case 90 To 99

        T = ChiffreLettre(Dizaine - 91) & "æÊÓÚæä "

    Case Else

        T = "ÎØà Ýí ÇáÊÍæíá !"

End Select

If Chaine <> "" Then

   If (T <> "") Then

   Chaine = Chaine

   T = "æ" & T

   End If

   End If

   If Chaine = "" Then

   If (T <> "") Then

   Chaine = Chaine

   T = T

   End If

   End If

If (Chaine & " " & T) = "" Then

    lireCentaine = ""

Else

    lireCentaine = LTrim(Chaine & " ") & T

End If

End Function

Function Modulo(ByVal Nombre As Double, ByVal Diviseur As Double) As Double

    Modulo = Nombre - (Diviseur * Int(Nombre / Diviseur))

End Function

Function Arrondir(ByVal ValeurArrondi As Double, ByVal NbreDeci As Integer) As Double

    Arrondir = ValeurArrondi + (5 * 10 ^ -(NbreDeci + 1))

    Arrondir = Int(Arrondir * 10 ^ NbreDeci) / 10 ^ NbreDeci

End Function

Function NombreToArabe(ByVal Total As Double) As String

    Dim Millions As Double

    Dim Milliers As Double

    Dim cent As Double

    Dim decimales As Double

    Dim T0 As String

    Dim T1 As String

    Dim T2 As String

    Dim T3 As String

    Dim Resultat As String

    Dim T As String

    Total = Arrondir(Total, 2)

    Millions = Int(Modulo(Int(Total / 1000000), 1000))

    Milliers = Int(Modulo(Int(Total / 1000), 1000))

    cent = Int(Modulo(Total, 1000))

    decimales = Arrondir((Modulo(Total * 100, 100)), 0)

    T0 = lireCentaine(Millions)

    T1 = lireCentaine(Milliers)

    T2 = lireCentaine(cent)

    T3 = lireCentaine(decimales)

   If T0 <> "" Then

   If (T1 <> "") Then

   If (T2 <> "") Then

   T0 = T0

   T1 = "æ" & T1

   T2 = "æ" & T2

   End If

   End If

   End If

   If T0 = "" Then

   If (T1 <> "") Then

   If (T2 <> "") Then

   T0 = T0

   T1 = T1

   T2 = "æ" & T2

   End If

   End If

   End If

   If T0 <> "" Then

   If (T1 <> "") Then

   If (T2 = "") Then

   T0 = T0

   T1 = "æ" & T1

   T2 = T2

   End If

   End If

   End If

   If T0 = "" Then

   If (T1 <> "") Then

   If (T2 = "") Then

   T0 = T0

   T1 = T1

   T2 = T2

   End If

   End If

   End If

   If T0 <> "" Then

   If (T2 <> "") Then

   If (T1 = "") Then

   T0 = T0

   T2 = "æ" & T2

   T1 = T1

   End If

   End If

   End If

   If T0 = "" Then

   If (T2 <> "") Then

   If (T1 = "") Then

   T0 = T0

   T1 = T1

   T2 = T2

   End If

   End If

   End If

   If T0 = "æÇÍÏ " Then

            T0 = ""

            Resultat = Resultat & T0 & "ãáíæä "

       End If

       If T0 = "ÇËäÇä " Then

          T0 = ""

        Resultat = Resultat & T0 & "ãáíæäÇä "

       End If

       If Millions >= 3 And Millions <= 10 Then

      Resultat = Resultat & T0 & "ãáÇííä "

       End If

      If Millions >= 11 And Millions <= 999 Then

       Resultat = Resultat & T0 & "ãáíæä "

    Else

        Resultat = Resultat & ""

    End If

        If T1 = "æÇÍÏ " Then

            T1 = ""

            Resultat = Resultat & T1 & "ÃáÝ "

        End If

        If T1 = "ÇËäÇä " Then

            T1 = ""

            Resultat = Resultat & T1 & "ÃáÝÇä "

        End If

        If Milliers >= 3 And Milliers <= 10 Then

        Resultat = Resultat & T1 & "ÂáÇÝ "

        End If

        If Milliers >= 11 And Milliers <= 999 Then

        Resultat = Resultat & T1 & "ÃáÝ "

    Else

        Resultat = Resultat & ""

    End If

    If T2 <> "" Then

        Resultat = Resultat & T2

        Else

        If Resultat <> "" Then

            Resultat = Resultat

        End If

    End If

    If T3 <> "" Then

        If Resultat <> "" Then

            Resultat = Resultat & " ÝÇÕáÉ " & T3

            Else

            Resultat = T3

        End If

    End If

    NombreToArabe = Resultat

End Function

Book1..rar

[Maher_mla]

افضل ان تأخذ الكود من المثال افضل وتضعه في اي ورقة عمل تخصك

طريقة سهلة كثير فقط افتح المثال المرفق ومن ثم اعرض التعليمات البرمجية التي يحتويها المثال

ومن ثم اضغط على

Module1

نقرة مزدوجة وسوف يضهر لك الكود حدده كله بالضغط على

Ctrl+A

ومن ثم انسخه واتبع نفس الطريق للأضافة لملفك

-----

اما ان اردت ان تكون العملية مختلفة فأنصحك بأستعمال دالة Mid

كمان كثير سهلة التعامل لا يلزمها اي شروحات

[المحاسب القائد]

استخدم الدالة vlookup

اسهل بكثير

مرفق مثال

VLOOKUP..rar

[احمد ابو لولى]

بس هذا العمل يصمم بالاكسس فقط

[tnt707]

استخدم الدالة vlookup

اسهل بكثير

مرفق مثال

مشكورين يا أخوان على المساعدة ما قصرتم جزاكم الله خيراً