إنتقال للمحتوى

ابحث فى الموقع مع جوجل

بحث مخصص

تأكد من صحة الحديث قبل نشره



بحث عن:

جديــــــد New

شبكة محترفى أوراكل

<




صورة

كود تفقيط وورد


  • من فضلك قم بتسجيل الدخول للرد
15 رد (ردود) على هذا الموضوع

#1 السيد عبد الفتاح

السيد عبد الفتاح
  • Members-1
  • 154 مشاركة
  • Gender:Male
  • Location:Kuwait
  • Interests:http://www.shbab1.com/2minutes.htm

تاريخ المشاركة 29 November 2010 - 11:38 AM

السادة / خبراء وأعضاء المنتدى ... المحترمين
أرجو المساعدة في ايجاد كود تفقيط يعمل على الوورد لعملة الدينار الكويتي علما بان كسر الدينار هو 1000 فلس ولكم جزيل الشكر

#2 أبـوخليل

أبـوخليل
  • مراقب عام
  • 5445 مشاركة
  • Gender:Male

تاريخ المشاركة 30 November 2010 - 03:59 PM

هذا مثال يحتوي على كود تفقيط
لعلك تجد فيه فائدة

ملفات مرفقة


تم التعديل بواسطة أبو الأنس, 30 November 2010 - 04:00 PM.


#3 السيد عبد الفتاح

السيد عبد الفتاح
  • Members-1
  • 154 مشاركة
  • Gender:Male
  • Location:Kuwait
  • Interests:http://www.shbab1.com/2minutes.htm

تاريخ المشاركة 01 December 2010 - 02:24 PM

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

#4 sft

sft
  • Members-1
  • 89 مشاركة

تاريخ المشاركة 01 December 2010 - 09:40 PM

وانا تمنيت ان أعرف الطريقة .... ؟؟؟؟؟؟؟

#5 عبـد الله

عبـد الله
  • Members-2
  • 190 مشاركة

تاريخ المشاركة 02 December 2010 - 03:46 PM

يا اخواني المسألة واضحة

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

السؤال : الا يمكن تحويل هذه الايقونة الى زر من ازرار لوحة المفاتيح ، لتسهيل التعامل ؟
لا إله الا انت سبحانك إني كنت من الظالمين

#6 deyamag

deyamag
  • Members-1
  • 21 مشاركة
  • Gender:Male

تاريخ المشاركة 05 December 2010 - 07:41 PM

الماكرو Disabled



#7 عبـد الله

عبـد الله
  • Members-2
  • 190 مشاركة

تاريخ المشاركة 06 December 2010 - 11:36 AM

عدل امان الماكرو الى منخفض
لا إله الا انت سبحانك إني كنت من الظالمين

#8 hussien030

hussien030
  • Members-1
  • 21 مشاركة

تاريخ المشاركة 06 December 2010 - 07:08 PM

ارجو يا سادة يا كرام مساعدتي في تثبيت كود التفقثط في الاكسل و الورد وربنا يجزيكم الخير

#9 أبـوخليل

أبـوخليل
  • مراقب عام
  • 5445 مشاركة
  • Gender:Male

تاريخ المشاركة 06 December 2010 - 08:32 PM

هذه فائدة من اخينا حامل المسك
برنامج تنفيذي لادراج التفقيط داخل الوورد
http://www.officena....

#10 محمود العامر

محمود العامر
  • Members-1
  • 10 مشاركة

تاريخ المشاركة 05 January 2011 - 12:42 AM

شكرا اخي على الكود

#11 محمود العامر

محمود العامر
  • Members-1
  • 10 مشاركة

تاريخ المشاركة 05 January 2011 - 12:43 AM

من اين يتم تحميل رابط هذا الكود

#12 تومي محمد

تومي محمد

    مدير قسم الوورد

  • مدير قسم
  • 725 مشاركة
  • Gender:Male

تاريخ المشاركة 16 March 2011 - 07:26 PM

تحويل عدد إلى حروف وان لا يكون العدد عشريا ولا يتعدى التحويل 999999 في M.Word بهذه الطريقة:
نضغط على ctrl+f9 لادراج حقل.

نكتب بين الحاضنتين : cardtext * \ .........= حيث النقط تمثل العدد المراد تحويله .
نضغط على Alt+F9 ليتم التحويل والمؤشر داخل الحقل .
نضغط SHIFT + F9 لتغيير العدد .
يفضل ان يكون خيار اللغة على انجليزي او فرنسي عند بداية كتابة الكود .
والسلام عليكم ورحمة الله وبركاته.


تم التعديل بواسطة تومي محمد, 03 November 2012 - 11:20 PM.

0c364c4361f100.jpg


#13 المقداد

المقداد
  • Members-1
  • 9 مشاركة

تاريخ المشاركة 09 January 2015 - 12:19 AM

اشكركم ولكن كيف يتم تعديل امان الماكرو في 2007 حيث يتم ارسال رسالة نختار منها ( تمكين) ولكن يظل بدون ايقونه



#14 أبو محمد عباس

أبو محمد عباس
  • Honored Members
  • 1420 مشاركة
  • Gender:Male

تاريخ المشاركة 10 January 2015 - 08:05 AM

السلام عليكم

اخي المقداد لاحظ الشرح على الرابط التالي للاستاذ احمد النجار جزاه الله خيرا

دمتم في رعاية الله وحفظه

http://www.officena.net/ib/index.php?showtopic=51032#entry314613


ماشاء الله تبارك الله ماشاء الله لاقوة الا بالله 

اللهم اني اسالك الهدى والتقى والعفاف والغنى


#15 hat

hat
  • Members-2
  • 139 مشاركة

تاريخ المشاركة 08 February 2015 - 07:21 PM

السلام عليكم

 

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

 

افتح ماكرو جديد وسمه (   word   ) مثلا 

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

ويمكن ان تخصص له زر في شريط الاوامر

وبعد الانتهاء اكتب الرقم ثم اضغط تنفيذ ماكرو (      word  )   او الاسم الذي اخترته    واستمتع بالتفقيط . 

 

وانا استخدم وورد  2013 لذلك سارفق ملف بصيغة وورد 97 و 2003 واذا لم يعمل على اصدارات وورد المختلفة ارجو تحويله للاصدار المناسب

 

 

ملف مرفق  فقط إثنا عشر ألفاً و خمسمائة و أربعة و أربعون ريالاً لا غير.rar   5.4كيلو   18 عدد مرات التحميل

 

 

Sub num2txt()
'
' num2txt Macro
'
'
Dim CursorMovement As Long
Sub num2text()
'
    On Error Resume Next
    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection = word(Selection)
  Selection.EndKey Unit:=wdLine
Selection.MoveDown
Selection.TypeBackspace
   Selection.TypeParagraph
 MsgBox "ادخل ارقام جدديدة واضغط للتحويل لارقام ", vbExclamation, "رسالة هاشم "
End Sub

Public Function word(x)
On Error Resume Next

ra = " ريالاً "
ha = " هللة "
n = Int(x)
b = Val(Right(Format(x, "000000000000000.00"), 2))
r = aword(n)
b1 = aword(b)

 If n > 999999999999999# Then
 MsgBox "هذا الرقم كبير جدأ .. لطفاً ادخل رقماً يقل عن 999.99 ترليون ", vbInformation, "رسالة هاشم "
Selection.Copy
Selection.Paste

Exit Function
End If
If b >= 3 And b <= 10 Then ha = " هللات "
If Right(n, 1) >= 3 And Right(n, 1) <= 10 Then

If Right(n, 2) < 10 Then ra = " ريالات "
End If
If b = 2 Then b1 = " هللتان ": ha = ""
If b = 1 Then b1 = " هللة واحدة ": ha = ""

If n = 1 Then r = "ريال واحد ": ra = ""

If r <> "" And b >= 0 Then Result = " فقط " & r & ra & " و" & b1 & ha & " لا غير ."
If r = "" And b <> 0 Then Result = " فقط " & b1 & ha & "  لا غير "

If r = "" And b = 0 Then Result = ""
If r <> "" And b = 0 Then Result = " فقط " & r & ra & " لا غير . "

word = Result

End Function

Private Function aword(x)
n = Int(x)
c = Format(n, "000000000000000")

c1 = Val(Mid(c, 15, 1))

Select Case c1
Case Is = 1: letr1 = "واحد"
Case Is = 2: letr1 = "إثنان"
Case Is = 3: letr1 = "ثلاثة"
Case Is = 4: letr1 = "أربعة"
Case Is = 5: letr1 = "خمسة"
Case Is = 6: letr1 = "ستة"
Case Is = 7: letr1 = "سبعة"
Case Is = 8: letr1 = "ثمانية"
Case Is = 9: letr1 = "تسعة"
End Select

c2 = Val(Mid(c, 14, 1))
Select Case c2
Case Is = 1: letr2 = "عشر"
Case Is = 2: letr2 = "عشرون"
Case Is = 3: letr2 = "ثلاثون"
Case Is = 4: letr2 = "أربعون"
Case Is = 5: letr2 = "خمسون"
Case Is = 6: letr2 = "ستون"
Case Is = 7: letr2 = "سبعون"
Case Is = 8: letr2 = "ثمانون"
Case Is = 9: letr2 = "تسعون"
End Select

If letr1 <> "" And c2 > 1 Then letr2 = letr1 + " و " + letr2
If letr2 = "" Then letr2 = letr1

If c1 = 0 And c2 = 1 Then letr2 = letr2 + "ة"

If c1 = 1 And c2 = 1 Then letr2 = "إحدى عشر"
If c1 = 2 And c2 = 1 Then letr2 = "إثنا عشر"

'If c1 = 2 And c2 = 0 Then letr2 = "ريالان"

If c1 > 2 And c2 = 1 Then letr2 = letr1 + "  " + letr2

c3 = Val(Mid(c, 13, 1))

Select Case c3
Case Is = 1: letr3 = "مائة"
Case Is = 2: letr3 = "مئتان"

Case Is = 8: letr3 = Left(aword(c3), Len(aword(c3)) - 2) + "مائة"
Case Is > 2: letr3 = Left(aword(c3), Len(aword(c3)) - 1) + "مائة"

End Select

If letr3 <> "" And letr2 <> "" Then letr3 = letr3 + " و " + letr2
If letr3 = "" Then letr3 = letr2

'=====
c4 = Val(Mid(c, 10, 3))

Select Case c4
Case Is = 1: letr4 = " ألف"
Case Is = 2: letr4 = " ألفان"
Case 3 To 10: letr4 = aword(c4) + " آلاف"
Case Is > 10: letr4 = aword(c4) + " ألفاً"

End Select

If letr4 <> "" And letr3 <> "" Then letr4 = letr4 + " و " + letr3

If letr4 = "" Then letr4 = letr3
'=====

c5 = Val(Mid(c, 7, 3))

Select Case c5
Case Is = 1: letr5 = " مليون"
Case Is = 2: letr5 = " مليونان"
Case 3 To 10: letr5 = aword(c5) + " ملايين"
Case Is > 10: letr5 = aword(c5) + " مليوناً"

End Select

If letr5 <> "" And letr4 <> "" Then letr5 = letr5 + " و " + letr4
If letr5 = "" Then letr5 = letr4

'==

c6 = Val(Mid(c, 4, 3))

Select Case c6
Case Is = 1: letr6 = " مليار"
Case Is = 2: letr6 = " ملياران"
Case 3 To 10: letr6 = aword(c6) + " مليارات"
Case Is > 10: letr6 = aword(c6) + " ملياراً"

End Select

If letr6 <> "" And letr5 <> "" Then letr6 = letr6 + " و " + letr5
If letr6 = "" Then letr6 = letr5

'=====

c7 = Val(Mid(c, 1, 3))

Select Case c7
Case Is = 1: letr7 = " ترليون"
Case Is = 2: letr7 = " ترليونان"
Case 3 To 10: letr7 = aword(c7) + " ترليونات"
Case Is > 10: letr7 = aword(c7) + " ترليوناً "

End Select

If letr7 <> "" And letr6 <> "" Then letr7 = letr7 + " و " + letr6
If letr7 = "" Then letr7 = letr6

aword = letr7

End Function

 

 

 



#16 hat

hat
  • Members-2
  • 139 مشاركة

تاريخ المشاركة 09 February 2015 - 10:52 AM

اسم الماكرو يكون num2txt  بدلا من word   لذا لزم التنويه

 


تم التعديل بواسطة hat, 09 February 2015 - 10:55 AM.





0 عضو (أعضاء) يشاهدون هذا الموضوع

0 الأعضاء, 0 الزوار, 0 مجهولين