اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

mosaline

بواسطه mosaline
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

mosaline

mosaline

قام بنشر
قام بنشر

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

 

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

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

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

 

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

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

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

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

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

 

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

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

post-92471-0-10743500-1363080715_thumb.j

post-92471-0-05390200-1363080727_thumb.j

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

  • Like 4
  • Thanks 1
حمادة عمر

حمادة عمر

قام بنشر
قام بنشر

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

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

hat

hat

قام بنشر
قام بنشر (معدل)

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

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

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

 

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

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

 

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

word.rar

تم تعديل بواسطه hat
  • Like 1
  • 3 weeks later...
  • 1 year later...
  • 8 months later...
قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر

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

جرب هذا الكود

 الكود 


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

 

  • 1 month later...
ah.moawad

ah.moawad

قام بنشر
قام بنشر

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

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

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

 

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

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

 

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

attachicon.gifword.rar

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

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

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

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

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

hat

hat

قام بنشر
قام بنشر

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

 

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

 

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

 

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

 

دمت بود

قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر (معدل)

الاخ العزيز

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

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

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

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

 

1425674616851.png

تم تعديل بواسطه قنديل الصياد
  • 1 year later...
زائر
هذا الموضوع مغلق.
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept