طلب مساعده كيف انسخ داله لجميع ملفات الاكسل ؟ مبتدء

[Ibrahim Ex]

السلام عليكم

 

عندي كود

Public Function Horof(x)
    Ma = " ريال"
    Mi = " هللة"
    N = Int(x)
    B = Val(Right(Format(x, "000000000000.00"), 2))
    R = SHorof(N)
    If R <> "" And B > 0 Then Result = "فقط" & " " & R & Ma & " و " & B & Mi & " " & "لا غير"
    If R <> "" And B = 0 Then Result = "فقط" & " " & R & Ma & " " & "لا غير"
    If R = "" And B <> 0 Then Result = "فقط" & " " & B & Mi & " " & "لا غير"
    Horof = Result
End Function
Private Function SHorof(x)
    N = Int(x)
    C = Format(N, "000000000000")
    c1 = Val(Mid(C, 12, 1))
    Select Case c1
    Case Is = 1: Letter1 = "واحد"
    Case Is = 2: Letter1 = "اثنان"
    Case Is = 3: Letter1 = "ثلاثة"
    Case Is = 4: Letter1 = "اربعة"
    Case Is = 5: Letter1 = "خمسة"
    Case Is = 6: Letter1 = "ستة"
    Case Is = 7: Letter1 = "سبعة"
    Case Is = 8: Letter1 = "ثمانية"
    Case Is = 9: Letter1 = "تسعة"
End Select
    c2 = Val(Mid(C, 11, 1))
    Select Case c2
    Case Is = 1: Letter2 = "عشر"
    Case Is = 2: Letter2 = "عشرون"
    Case Is = 3: Letter2 = "ثلاثون"
    Case Is = 4: Letter2 = "اربعون"
    Case Is = 5: Letter2 = "خمسون"
    Case Is = 6: Letter2 = "ستون"
    Case Is = 7: Letter2 = "سبعون"
    Case Is = 8: Letter2 = "ثمانون"
    Case Is = 9: Letter2 = "تسعون"
    End Select
    
    If Letter1 <> "" And c2 > 1 Then Letter2 = Letter1 + " و" + Letter2
    If Letter2 = "" Then Letter2 = Letter1
    If c1 = 0 And c2 = 1 Then Letter2 = Letter2 + "ة"
    If c1 = 1 And c2 = 1 Then Letter2 = "احدى عشر"
    If c1 = 2 And c2 = 1 Then Letter2 = "اثنى عشر"
    If c1 > 2 And c2 = 1 Then Letter2 = Letter1 + " " + Letter2
    c3 = Val(Mid(C, 10, 1))
    Select Case c3
    Case Is = 1: Letter3 = "مائة"
    Case Is = 2: Letter3 = "مئتان"
    Case Is > 2: Letter3 = Left(SHorof(c3), Len(SHorof(c3)) - 1) + "مائة"
    End Select
    If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
    If Letter3 = "" Then Letter3 = Letter2
    
   C4 = Val(Mid(C, 7, 3))
   Select Case C4
   Case Is = 1: Letter4 = "الف"
   Case Is = 2: Letter4 = "الفان"
   Case 3 To 10: Letter4 = SHorof(C4) + " آلاف"
   Case Is > 10: Letter4 = SHorof(C4) + " الف"
   End Select
   If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
   If Letter4 = "" Then Letter4 = Letter3
   C5 = Val(Mid(C, 4, 3))
   Select Case C5
   Case Is = 1: Letter5 = "مليون"
   Case Is = 2: Letter5 = "مليونان"
   Case 3 To 10: Letter5 = SHorof(C5) + " ملايين"
   Case Is > 10: Letter5 = SHorof(C5) + " مليون"
   End Select
   If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
   If Letter5 = "" Then Letter5 = Letter4
   
   C6 = Val(Mid(C, 1, 3))
   Select Case C6
   Case Is = 1: Letter6 = "مليار"
   Case Is = 2: Letter6 = "ملياران"
   Case Is > 2: Letter6 = SHorof(C6) + " مليار"
   End Select
   If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
   If Letter6 = "" Then Letter6 = Letter5
   SHorof = Letter6
   
End Function

كيف اضيفها في جميع ملفات الاكسل

 

لانها تشتغل بس بملف واحد

 

ارجو مساعدتي فانا مبتدء

 

اكسل 2013

[ابو علي و سدرة]

بص هو الفكرة العامة انك تحفظها كاضافة على الاكسيل بتختار Save as ومنها بتحدد save as type ودى بتختار منها Excel Add in

[ibn_egypt]

اخى الفاضل

 

أولا هتفتح ملف اكسل جديد وتدخل على محرر الأكواد VBA  بالضغط على ALT+F11 هتعمل موديول جديد وتلصق فيه الدالة بتاعتك "الكود السابق" ... 

 

ثانيا هتعمل حفظ باسم عادى جدا وقم بتسمية الملف باى اسم تريده ولكن يفضل باللغة الانجليزية .. اهم شئ انك تختار نوع الملف Excel Add-in  xlam واحفظها في اى مكان على جهاز

 

واقفل الملف 

 

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

 

اعتذر عن عدم التوضيح بالصور

 

جرب ولو فيه شئ أخبرنا به

 

تحياتي  

[Ibrahim Ex]

اخى الفاضل

 

أولا هتفتح ملف اكسل جديد وتدخل على محرر الأكواد VBA  بالضغط على ALT+F11 هتعمل موديول جديد وتلصق فيه الدالة بتاعتك "الكود السابق" ... 

 

ثانيا هتعمل حفظ باسم عادى جدا وقم بتسمية الملف باى اسم تريده ولكن يفضل باللغة الانجليزية .. اهم شئ انك تختار نوع الملف Excel Add-in  xlam واحفظها في اى مكان على جهاز

 

واقفل الملف 

 

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

 

اعتضر عن عدم التوضيح بالصور

 

جرب ولو فيه شئ أخبرنا به

 

تحياتي  

 

 

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

[Ibrahim Ex]

يا اخوان اريد التعديل على الداله بحيث انها تجبر النص

 

مثلا يكون الرقم 54.5

تقراه خمسة واربعون ريال

 

مو اربعة وخمسون ريال ونص

 

واكون شاكر لكم

[ibn_egypt]

يا اخوان اريد التعديل على الداله بحيث انها تجبر النص

 

مثلا يكون الرقم 54.5

تقراه خمسة واربعون ريال

 

مو اربعة وخمسون ريال ونص

 

واكون شاكر لكم

 

اخى الفاضل

 

جرب اجعل معادلتك هكذا

=Horof(ROUND(J9,0))

تحياتي  

[Ibrahim Ex]

 

يا اخوان اريد التعديل على الداله بحيث انها تجبر النص

 

مثلا يكون الرقم 54.5

تقراه خمسة واربعون ريال

 

مو اربعة وخمسون ريال ونص

 

واكون شاكر لكم

 

اخى الفاضل

 

جرب اجعل معادلتك هكذا

=Horof(ROUND(J9,0))

تحياتي  

 

اخي الكريم

 

المشكلة ما تغير شي

[ibn_egypt]

اخى الفاضل

 

أستأذنك أرفق ملف به الدالة 

 

تحياتي  

[ibn_egypt]

اخى الفاضل

 

إزاى لم يتغير شئ .. الدالة شغالة معايا كويس جدا .. جرب المرفق

 

تحياتي

Horof.rar

[Ibrahim Ex]

الله يسلمك اخي الداله حقك طلعة بالجنيه

 

هكذا

 

 

 

 

انا اريد الداله تطلع بهذا الشكل

 

 

 

 

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

[ibn_egypt]

أخى الفاضل

 

لو دخلت على الكود .. تقدر تغير "جنيه" تخليها "ريال" وتغير "قرش" تخليها "هلله" .. مرفق الملف بعد التعديل

 

تحياتي  

Horof.rar

[Ibrahim Ex]

ابشرك زبط

 

الله يسعدك كان عندي غلط في الكود

 

 

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