من رقم إلى كتابة تفقيط عربي مميز

[mosaline]

بسم الله الرحمن الرحيم

 

الحمد لله رب العالمين والصلاة والسلام علي سيدنا محمد النبي الامين وعلي من سار بهديه الي يوم الدين اما.....بعد

في موضوع لي سابق طرحت كود تفقيط لتحويل الأرقام من أرقام إلى كتابة لكن (إنجليزي)

http://www.officena.net/ib/index.php?showtopic=45828&hl=

 

اليوم سأطرح لكم كود تفقيط أو ملف جاهز لإضافته في الفيجول بيسك بكل سهوله وإستخدامه كداله كاي داله أساسيه في الإكسيل

طريقة إضافة ملف التفقيط :

حمل ملف التفقيط من المرفقات وافتح ملف الإكسيل وإظغط على Alt+F11 وبعدها ستفتح لك صفحة الفيجول بيسك

إذهب إلى File وبعدها Import File وضع الملف وأغلق الفيجول بيسك  

في الإكسيل إذهب الداله المعرفة من قبل المستخدم وستجدها NoToTxt وتابع الإدخالات كما في الصور المرفقة

 

المميز في هذا التفقيط , يمكنك إضافة أي عمله مثل

ريال"هلله_جنيه"قرش_دينار"فلس

ملف تفقيط + إكسل شيت.rar

[عمر أبو صهيب]

عمل جد رائع

أحسن الله إليك أخي الكريم

[عمرو رحيل]

شكرا جزيلا لك اخى الكريم وجعله الله فى ميزان حسناتك باذن الله

[حمادة عمر]

شكرا جزيلا لك اخى الكريم وجعله الله فى ميزان حسناتك باذن الله

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

[mosaline]

عمر أبو صهيب

 

عمرو رحيل

 

حمادة عمر

 

شاكر لكم مروركم وأتمنى أن أكون قد وفقت في شرح تركيب ملف التفقيط ويكون قد أفادكم

[منياوى]

رائع والف شكر

[mosaline]

الرائع مشاركتك أخ jo11 وأتشرف بمرورك على الموضوع

[hat]

الملف المرفق به تنسيق تفقيط الارقام بالعربي وتوضع في مسار Addins   و لا تنسي تفعيل الخيار  على حسب الاوفيس الذي بحوزتك مثلا اوفيس 2007 خيارات الوظائف الاضافية ثم ضع علامة صح امام كلمة وورد

بعد أن تذهب الى مستخدمون على محرك الاقراص واختيار المستخدم ثم Appdata  ثم Roaming ثم microsoft ثم AddIns والصق الملف هناك  .

ولا تنس اظها الملفات المخفية من خيارات المجلد حتي يظهر لك مسار الملف المذكور .

 

بعد ذلك افتح ملف اوفيس  

وكل ما هناك تكتب كلمة word ثم بين قوسين عنوان الخلية التي بها الرقم مثلا a1 او B6

 

واستمتع ...:)

word.rar

تم تعديل مارس 17, 2013 بواسطه hat

[ابراهيم علي iah]

عمل أكثر من ممتاز سلمت يداك

[محمدي عبد السميع]

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

mosaline

[ibrahimelshal]

تسلم اخى ولكن نريده بالجنيه المصري

[ADNANSAKRAN]

أحسن الله إليك أخي الكريم

[peter_naser]

شكرآ علي المجهود 

بس للاسف بالدينار بيكتب بدلا من .250 فلس مائتان وخمسون فلس بيكتبها خمسة وعشرون  

 

 

 

[قنديل الصياد]

اخى العزيز بعد اذن اساتذتنا الكرام

جرب هذا الكود

 الكود

Function write_Number(numberp) ' برنامج التفقيط
On Error Resume Next
Dim ttpa, xp, a, number_s, fl As String
number_s = Str(numberp)
If Left(Right(number_s, 2), 1) = "." Then number_s = number_s & "0"
If Left(Right(number_s, 3), 1) <> "." Then number_s = number_s & ".00"
number_s = Trim(number_s)
' MsgBox " number_s = " & number_s
zp = Len(number_s)
z = 1
Do While zp > 0
c1 = ""
c2 = ""
c3 = ""
If zp = 12 Or zp = 9 Or zp = 6 Then
a = Mid(number_s, z, 1)
zp = zp - 1
Select Case a
Case "0"
c3 = ""
Case "1"
c3 = "ومائة "
Case "2"
c3 = "ومائتان "
Case "3"
c3 = "وثلاثمائة "
Case "4"
c3 = "واربعمائة "
Case "5"
c3 = "وخمسمائة "
Case "6"
c3 = "وستمائة "
Case "7"
c3 = "وسبعمائة "
Case "8"
c3 = "وثمانمائة "
Case "9"
c3 = "وتسعمائة "
End Select
z = z + 1
End If
If zp = 3 Then
z = z + 1
zp = zp - 1
End If
a = Mid(number_s, z, 1)
If zp = 2 Or zp = 5 Or zp = 8 Or zp = 11 Then
Select Case a
Case "0"
c2 = ""
Case "1"
c2 = "عشر "
Case "2"
c2 = "وعشرون "
Case "3"
c2 = "وثلاثون "
Case "4"
c2 = "واربعون "
Case "5"
c2 = "وخمسون "
Case "6"
c2 = "وستون "
Case "7"
c2 = "وسبعون "
Case "8"
c2 = "وثمانون "
Case "9"
c2 = "وتسعون "
End Select
zp = zp - 1
z = z + 1
End If
a = Mid(number_s, z, 1)
If zp = 1 Then ' الهللات
Select Case a
Case "0"
c1 = ""
Case "1"
If c2 = "عشر " Then
c1 = "واحدى "
Else
c1 = "وواحد "
End If
Case "2"
If c2 = "عشر " Then
c1 = "واثنتا "
Else
c1 = "واثناتان "
End If
Case "3"
c1 = "وثلاث "
Case "4"
c1 = "واربع "
Case "5"
c1 = "وخمس "
Case "6"
c1 = "وست "
Case "7"
c1 = "وسبع "
Case "8"
c1 = "وثمان "
Case "9"
c1 = "وتسع "
End Select
Else ' الريالات
Select Case a
Case "0"
c1 = ""
If c2 = "عشر " Then
c2 = "وعشرة "
End If
Case "1"
If c2 = "عشر " Then
c1 = "واحدى "
Else
c1 = "وواحد "
End If
Case "2"
If c2 = "عشر " Then
c1 = "واثنا "
Else
c1 = "واثنان "
End If
Case "3"
c1 = "وثلاثة "
Case "4"
c1 = "واربعة "
Case "5"
c1 = "وخمسة "
Case "6"
c1 = "وستة "
Case "7"
c1 = "وسبعة "
Case "8"
c1 = "وثمانة "
Case "9"
c1 = "وتسعة "
End Select
End If
zp = zp - 1
z = z + 1
Select Case zp
Case 9
Select Case c1 + c2 + c3
Case "وواحد "
xp = xp + "ومليون "
Case "واثنان "
xp = xp + "ومليونان"
Case Else
xp = xp + c3 + c1 + c2 + "مليون "
End Select
Case 6
Select Case c1 + c2 + c3
Case "وواحد "
xp = xp + "والف "
Case "واثنان "
xp = xp + "والفان "
Case "وثلاثة "
xp = xp + "وثلاثة الاف "
Case "واربعة "
xp = xp + "واربعة الاف "
Case "وخمسة "
xp = xp + "وخمسة الاف "
Case "وستة "
xp = xp + "وستة الاف "
Case "وسبعة "
xp = xp + "وسبعة الاف "
Case "وثمانية "
xp = xp + "وثمانية الاف "
Case "وتسعة "
xp = xp + "وتسعة الاف "
Case Else
If c2 = "وعشرة " Then
xp = xp + c3 + c1 + c2 + "الاف "
Else
xp = xp + c3 + c1 + c2 + "الف "
End If
End Select
Case 3
If c2 = "" Then
Select Case c1
Case ""
c1 = "ريال "
Case "وواحد "
c1 = "وريالا "
Case "واثنان "
c1 = "وريالان "
Case "وثلاثة "
c1 = "وثلاثة ريالات "
Case "واربعة "
c1 = "واربعة ريالات "
Case "وخمسة "
c1 = "وخمسة ريالات "
Case "وستة "
c1 = "وستة ريالات "
Case "وسبعة "
c1 = "وسبعة ريالات "
Case "وثمانية "
c1 = "وثمانية ريالات "
Case "وتسعة "
c1 = "وتسعة ريالات "
End Select
xp = xp + c3 + c1 + c2
Else
xp = xp + c3 + c1 + c2 + "ريالاً "
End If
Case 0
If c1 + c2 <> "" Then
If c2 = "" Then
Select Case c1
Case "وواحد "
xp = xp + "وهلله واحده"
Case "واثنان "
xp = xp + "وهللتان "
Case Else
xp = xp + c1 + "هللات "
End Select
Else
xp = xp + c1 + c2 + "هللة "
End If
End If
End Select
Loop
xp = LTrim(xp)
zp = Len(xp) - 1
If Left(xp, 1) = "و" Then
xp = Mid(xp, 2, zp)
End If
ttpa = xp
write_Number = ttpa
End Function

الدالة

=NoToTxt2(H1;"دينار";"فلس")

مرفق ملف مجرب عليه الكود

 

الصياد_تفقيط.rar

 

[ah.moawad]

الملف المرفق به تنسيق تفقيط الارقام بالعربي وتوضع في مسار Addins   و لا تنسي تفعيل الخيار  على حسب الاوفيس الذي بحوزتك مثلا اوفيس 2007 خيارات الوظائف الاضافية ثم ضع علامة صح امام كلمة وورد

بعد أن تذهب الى مستخدمون على محرك الاقراص واختيار المستخدم ثم Appdata  ثم Roaming ثم microsoft ثم AddIns والصق الملف هناك  .

ولا تنس اظها الملفات المخفية من خيارات المجلد حتي يظهر لك مسار الملف المذكور .

 

بعد ذلك افتح ملف اوفيس  

وكل ما هناك تكتب كلمة word ثم بين قوسين عنوان الخلية التي بها الرقم مثلا a1 او B6

 

واستمتع ...:)

word.rar

بارك الله فيك اخي على ملفك الرائع

بس بعد وضعه داخل المسار المطلوب تم العمل بنجاح

ولكن بعد اغلاق الشيت وفتح شيت اخر يعمل ولكن ببط والاكسيل يهنق تماماً ولا يستجيب

الا بعد الغاء الاضافة

فما الحل علماً باني اريد هذا الملف بالتحديد

[hat]

وبارك فيك سيدي الفاضل

 

ما هو نوع الاوفيس الذي تستخدمه ؟

[Yasser Fathi Albanna]

عمل أكثر من رائع

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

[قنديل الصياد]

بعد اذن الاخوة الافاضل

اليكم ملف للتفقيط بجميع العملات

 

 

الصياد_تفقيط.rar

[hat]

جزاك الله خيرا يا قنديل

 

ولكن هذه الداله لاجزاء الالف اي تصلح للدينار وما في قيمتها 

 

لكن مائتان واربعون قرش في الحقيقه هم جنيهان واربعون قرشا 

 

لذلك ساعمل على فصلها وادراج الدالتين مع لعضعما ليكونا لجميع العملات  .

 

دمت بود

[قنديل الصياد]

الاخ العزيز

مائتان واربعون قرش في الحقيقه هم جنيهان واربعون قرشا

ما المشكلة فى ذلك اذا كانت الدالة تعطينى نفس ما قلت حضرتك

اليك صورة من الملف ومطبق عليها المبلغ الذي ذكرته

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

 

تم تعديل مارس 6, 2015 بواسطه قنديل الصياد

[aboammar1963]

أعجبني الموضوع ألف شكر على المجهود