اذهب الي المحتوي
أوفيسنا

hat

03 عضو مميز
  • Posts

    148
  • تاريخ الانضمام

  • تاريخ اخر زياره

كل منشورات العضو hat

  1. السلام عليكم الاخوه الكرام سبق وان وضعنا كود تفقيط لوورد واجد مازرال هناك بعض الاخوه يسألون لذلك سوف ابسط المسالة قدر الامكان افتح ماكرو جديد وسمه ( word ) مثلا انسخ الكود التالي داخل الماكرو واحفظه ويمكن ان تخصص له زر في شريط الاوامر وبعد الانتهاء اكتب الرقم ثم اضغط تنفيذ ماكرو ( word ) او الاسم الذي اخترته واستمتع بالتفقيط . وانا استخدم وورد 2013 لذلك سارفق ملف بصيغة وورد 97 و 2003 واذا لم يعمل على اصدارات وورد المختلفة ارجو تحويله للاصدار المناسب فقط إثنا عشر ألفاً و خمسمائة و أربعة و أربعون ريالاً لا غير.rar 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
  2. يكفي ان تضغط الغاء الحماية لتشاهد الصيغ في الخانات كلها وانا استخدم اوفيس 2013 وحفظت الملف بصيغة 2003 فلا ادري سيفتح معك ام لا ؟ وارجو ان اكون قد وضحت لك الفكرة لتبدع فيها من نفسك وتطورها ولك تحياتي المصنف1.rar
  3. الاخ / خزاني الاخ يريد دالة يستخدمها في ملفاته الخاصة فلا تبخل عليه بملف مفتوح حتى يستفيد اما ان تعطيه الحل فهو لا يريد هذا ولك الشكر فهذا المنتدى تعليمي وكل الملفات به للتعليم وتبادل الافكار وتعلمنا من اشياء كثيرة من اساتذة افاضل وساعمل على هذه الدالة وارسلها له مفتوحة ليستفاد منها ولك جزيل الشكر
  4. الحل اخي الكريم تعمل قالب وتحفظه بصيغة word Teplate من تبويب حفظ كنوع وعند العمل تفتح هذا القالب حتى وتعمل عليه وتحفظ عملك عادى باي اسم ولكن ليس بصيغة قالب كعمل عادي والقالب بان تعمل ادراج رأس وتذييل الصفحات ثم تذهب الى تذييل الصفحة وتكتب اسمك وممكن تعمل ادراج التاريخ والوقت بصيخة الأن . وشاهد المرفق يمكن ان تعدل عليه وتحذف ما لا تحتاجه نموذج باسم الكاتب والتاريخ ورقم الصفحة.rar
  5. السلام عليكم ورحمة الله وبركاته اخي الفاضل اكتب في اي الخانتين يعني ممكن تكتب الاولى 13 والاخرى 20 او العكس وكل ما هنالك عند الطباعة اذا وجدت مشكة اجعل اتجاه الصفحة افقي وستنحل المشكة .
  6. السلام عليكم ورحمة الله وبركاته اخي الفاضل حسب فهمي انك تريد الطباعة على ورقة بابعاد ثابته في كل مرة وان كان هذا ماتقصد فاليك الحل بطريقتين مختلفتين : 1- من قائمة تخطيط الصفحة او اعداد الصفحة حسب نسخة وورد حدد حجم الورقة والهوامش التي تريد ثم اضغط على كلمة تعيين كافتراضي اي جعلها هوامش افتراضية وعندما تفتح الصفحة ستجدها بنفس التخطيط في كل مرة . 2- يمكن ان تحفظ الصفحة بعد التعديلات التي تجريها كل مرة وعبيء البيانات المكررة ثم احفظها من قائمة ملف حفظ باسم كنوع قالب Template وعند الكتابة مرة اخرى كل ما تفعله اختيار ملف جديد ثم تذهب الى القوالب ستجد الصفحة هناك افتحها واكتب ما تريد ثم احفظها باسم مختلف . ارجو ان اكون ساعدتك حسب علمي المتواضع ولك جزيل الشكر .
  7. الاخ ابو عبد الرحمن نادر السلام عليكم ورحمة الله وبركاته وبعد اعتقد المشكلة هي انك تطرح في الحقيقة العدد 50 من ناتج الخليه الذي هو في الحقيقة 0.5 اي نصف ولكنه مقرب للاعلى لذلك عند عملية الطرح يرجع كل رقم الى قيمته الصحيحة وهو نصف لذلك عند الطرح يكون الناتج 49.5 وعند ظهور المجموع يعود مقرب الى واحد صحيح كما في الخانة FC لذلك لو وضعت تنسيق الرقم في ذات الخانة الى اي عدد كسري سوف يظهر الناتج بطريقة صحيحة لذلك يجب ان تكتب في الخلية FC الصيغة التالية = ( ROUNDDOWN (50-FB5;0 و هي تعني التقريب لاسفل لعدد عشري واحد ارجو ان اكون وفقت الى ما تريد مع شديد اسفي ان كان هذا ما لا تريده . تحياتي للجميع
  8. الاخ عباس السماوي اكتب الرقم ثم اختار المطور من شريط الادوات ثم نفذ الماكرو بكل بساطة
  9. بسم الله الرحمن الرحيم الاساتذة / عباس السماوي وأبو محمد أشرف السلام عليكم ورحمة الله وبركاته ، وعلى جميع رواد المنتدى اولا اشكركم جزيل الشكر للردود الكريمة وبعد بخصوص التعرف على العدد فهو في الجزء العلوي من الكود هناك Sub num2text() ' ' Selection.HomeKey Unit:=wdLine هنا ينتقل المؤشر الى بداية الرقم Selection.EndKey Unit:=wdLine, Extend:=wdExtend وهنا يتم تحديد الرقم بالانتقال الى نهاية العدد Selection = word(Selection) وهنا يتم وضع التحديد الذي هو العدد في المتغير المحدد وبعد ذلك يأتي دور دالة word التي تحول المتغير الى صيغة كلمات عددية End Sub والملاحظ ان يتم كتابة عدد فقط بدون كلمات لأن التحديد يتم لجميع الجملة فبعد كتابة الرقم وتحويله الى نص يمكنك اضافة اي بيانات لاحقة ارجو ان اكون قد وفقت بالشرح ودمتم بود
  10. الأخ الفاضل / أبو محمد أشرف السلام عليكم ورحمة الله وبركاته ،، أشكرك يا سيدي على النصيحة ولكن هذا الماكرو للورد وليس لأكسيل لذا لزم التنويه مع فهو يستخدم مع ملفات وورد فقط وليس اكسيل . مع انه يشبه ملفات اكسيل ولكن الفرق في الثلاث سطور الاولى التي تتيح اختيار الارقام أما في اكسيل فانت تضع عنوان الخلية وقد ارفقت ماكرو لاكسيل بنفس المعنى ولكنه مختلف . دمت بود اخوكم هاشم احمد طه
  11. الملف المرفق به تنسيق تفقيط الارقام بالعربي وتوضع في مسار Addins و لا تنسي تفعيل الخيار على حسب الاوفيس الذي بحوزتك مثلا اوفيس 2007 خيارات الوظائف الاضافية ثم ضع علامة صح امام كلمة وورد بعد أن تذهب الى مستخدمون على محرك الاقراص واختيار المستخدم ثم Appdata ثم Roaming ثم microsoft ثم AddIns والصق الملف هناك . ولا تنس اظها الملفات المخفية من خيارات المجلد حتي يظهر لك مسار الملف المذكور . بعد ذلك افتح ملف اوفيس وكل ما هناك تكتب كلمة word ثم بين قوسين عنوان الخلية التي بها الرقم مثلا a1 او B6 واستمتع ...:) word.rar
  12. هذا الماكرو يحول الارقام الى عملة بالريال السعودي ويمكنك تغيير العملة في اول الكود لأي عملة تريدها Sub num2text() ' ' ' Selection.HomeKey Unit:=wdLine Selection.EndKey Unit:=wdLine, Extend:=wdExtend Selection = word(Selection) 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 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
  13. السلام عليكم ورحمة الله وبركاته ، أتعامل مع اوفيس منذ عام 1995 عندما كان ويندوز 3.1 ويأتي على 7 اقراص تسمى ( 3.5 بوصة ) أنفرضت الآن ولله الحمد والمنة . وأرى أن أفضل برامج الاوفيس 2010 وأتعامل مع 2013 بكل سهولة .
  14. السلام عليكم ورحمة الله وبركاته الاخ تومي ما هو نوع الاوفيس الذي تستخدمه ؟؟ ونوع الويندوز ؟ شكرا لك
  15. السلام عليكم ورحمة الله وبركاته هذه المشكلة متضمنه بمخطط الاحرف مثل لفظ الجلالة بعد كتابته تظهر الشدة والالف الصغيرة تلقائياً ولتجنب هذه المشكلة قم بوضع مسافة بين الياء والألف ( بعد كتابة الياء اضغط مفتاح shift + حرف التاء في نفس الوقت ) ومن ثم اكتب حرف الالف . ارجو ان اكون قد اوصلت المعلومة . جزاك الله خيراً
  16. عفواً .. أحذف جميع الكلمات التي بين [ ] والقوسين ايضاً من الكود مثلا [ /left] و
  17. كود تفقيط سهل جداً انسخ الكود التالي في موديل جديد من قائمة محرر فيجوال بيسك في وورد وضع له اختصار وظيفة اضافية على شريط الادوات ثم اكتب اي رقم وشغل الماكرو واعلمني بالنتيجة وشكرا لكم سلفا اخوكم هاشم احمد طه [/left] [left] Public Function word(x) On Error Resume Next[/left] [left] ra = " ريالاً " ha = " هللة " n = Int(x) b = Val(Right(Format(x, "000000000000000.00"), 2)) r = aword(n) b1 = aword(b) If Len(n) > 15 Then MsgBox " عفواً.... هذه الأداة لا تدعم أكثر من 15 خانة عددية ولأقرب جزء من مائة " & Chr$(13) & Chr$(13) & " وأعتقد بأن هذه الرقم يكفي لإنجاز أي عملية حسابية .", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تحويل الارقام الى نص" Exit Function End If[/left] [left]If n < 0 Then[/left] [left]q = " يتبقى لكم " Else q = " فقط " End If[/left] [left] If b >= 3 And b <= 10 Then ha = " هللات " If Right(n, 1) >= 3 And Right(n, 1) <= 10 Then[/left] [left]If Right(n, 2) < 10 Then ra = " ريالات " End If If b = 2 Then b1 = " هللتان ": ha = "" If b = 1 Then b1 = " هللة واحدة ": ha = ""[/left] [left]If n = 1 Then r = "ريال واحد ": ra = ""[/left] [left]If r <> "" And b >= 0 Then Result = q & r & ra & " و" & b1 & ha & " لا غير ." If r = "" And b <> 0 Then Result = q & b1 & ha & " لا غير "[/left] [left]If r = "" And b = 0 Then Result = "" If r <> "" And b = 0 Then Result = q & r & ra & " لا غير . "[/left] [left]word = Result[/left] [left]End Function[/left] [left]Private Function aword(x) n = Int(x) If n < 0 Then n = n * -1 - 1[/left] [left]c = Format(n, "000000000000000") 'If Len(c) > 15 Then ' MsgBox " عفواً.... هذه الأداة لا تدعم أكثر من 15 خانة عددية ولأقرب جزء من مائة " & Chr$(13) & " وأعتقد بأن هذه الرقم يكفي لإنجاز أي عملية حسابية .", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تحويل الارقام الى نص" ' Exit Function ' End If c1 = Val(Mid(c, 15, 1))[/left] [left]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[/left] [left] 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[/left] [left]If letr1 <> "" And c2 > 1 Then letr2 = letr1 + " و " + letr2 If letr2 = "" Then letr2 = letr1[/left] [left]If c1 = 0 And c2 = 1 Then letr2 = letr2 + "ة"[/left] [left]If c1 = 1 And c2 = 1 Then letr2 = "إحدى عشر" If c1 = 2 And c2 = 1 Then letr2 = "إثنا عشر"[/left] [left]'If c1 = 2 And c2 = 0 Then letr2 = "ريالان"[/left] [left]If c1 > 2 And c2 = 1 Then letr2 = letr1 + " " + letr2[/left] [left] c3 = Val(Mid(c, 13, 1))[/left] [left]Select Case c3 Case Is = 1: letr3 = "مائة" Case Is = 2: letr3 = "مئتان"[/left] [left]Case Is = 8: letr3 = Left(aword(c3), Len(aword(c3)) - 2) + "مائة" Case Is > 2: letr3 = Left(aword(c3), Len(aword(c3)) - 1) + "مائة"[/left] [left]End Select[/left] [left]If letr3 <> "" And letr2 <> "" Then letr3 = letr3 + " و " + letr2 If letr3 = "" Then letr3 = letr2[/left] [left]'===== c4 = Val(Mid(c, 10, 3))[/left] [left]Select Case c4 Case Is = 1: letr4 = " ألف" Case Is = 2: letr4 = " ألفان" Case 3 To 10: letr4 = aword(c4) + " آلاف" Case Is > 10: letr4 = aword(c4) + " ألفاً"[/left] [left]End Select[/left] [left]If letr4 <> "" And letr3 <> "" Then letr4 = letr4 + " و " + letr3[/left] [left]If letr4 = "" Then letr4 = letr3 '=====[/left] [left] c5 = Val(Mid(c, 7, 3))[/left] [left]Select Case c5 Case Is = 1: letr5 = " مليون" Case Is = 2: letr5 = " مليونان" Case 3 To 10: letr5 = aword(c5) + " ملايين" Case Is > 10: letr5 = aword(c5) + " مليوناً"[/left] [left]End Select[/left] [left]If letr5 <> "" And letr4 <> "" Then letr5 = letr5 + " و " + letr4 If letr5 = "" Then letr5 = letr4[/left] [left]'==[/left] [left]c6 = Val(Mid(c, 4, 3))[/left] [left]Select Case c6 Case Is = 1: letr6 = " مليار" Case Is = 2: letr6 = " ملياران" Case 3 To 10: letr6 = aword(c6) + " مليارات" Case Is > 10: letr6 = aword(c6) + " ملياراً"[/left] [left]End Select[/left] [left]If letr6 <> "" And letr5 <> "" Then letr6 = letr6 + " و " + letr5 If letr6 = "" Then letr6 = letr5[/left] [left]'=====[/left] [left]c7 = Val(Mid(c, 1, 3))[/left] [left]Select Case c7 Case Is = 1: letr7 = " ترليون" Case Is = 2: letr7 = " ترليونان" Case 3 To 10: letr7 = aword(c7) + " تريليونات" Case Is > 10: letr7 = aword(c7) + " تريليوناً"[/left] [left]End Select[/left] [left]If letr7 <> "" And letr6 <> "" Then letr7 = letr7 + " و " + letr6 If letr7 = "" Then letr7 = letr6[/left] [left]aword = letr7[/left] [left] End Function[/left] [left] ' by Hashim Ahmed Taha Public Sub Main()[/left] [left] Selection.HomeKey Unit:=wdLine Selection.EndKey Unit:=wdLine, Extend:=wdExtend sWhole = Selection.Text Selection.TypeText word(sWhole)[/left] [left]End Sub[/left] [left]
  18. السلام عليكم ورحمة الله وبركاته الاخ الفاضل هذا الموضوع ليس ادراج نص تشعبي ولكن جدول محتويات قم بكتابة اي موضوع من ثلاث صفحات أو أكثر ثم طبق التالي على كلمات اختارها انت في كل صفحة ثم اذهب الى الصفحة الاخيرة وقم بانشاء جدول محتويات كما هو سيأتي بع : 1. حدد الجزء الأول من النص الذي تريد تضمينه في جدول المحتويات. 2. اضغط ALT+SHIFT+O. 3. في المربع المستوى، حدد المستوى ثم انقر فوق وضع علامة. 4. لوضع علامة على إدخالات إضافية، حدد النص، انقر في المربع إدخال، ثم انقر فوق وضع علامة. عند الانتهاء من إضافة الإدخالات، انقر فوق إغلاق. 5. انقر حيث تريد إدراج جدول المحتويات. 6. في القائمة إدراج، أشر إلى مرجع، وانقر فوق فهرسة وجداول. 7. انقر فوق علامة التبويب جدول المحتويات. 8. انقر فوق الزر خيارات. 9. في المربع خيارات جدول المحتويات، حدد خانة الاختيار حقول الإدخال في الجدول. 10. امسح خانتي الاختيار الأنماط ومستويات المخطط التفصيلي.
  19. السلام عليكم من قائمة ادوات ثم خيارات ثم تبويب عرض وتحت خيارات الاطار قم بازالة العلامة امام خطوط الشبكة ثم موافق دمتم بود
  20. ِALMAISTRO السلام عليكم ورحمة الله وبركاته ،، هل تذكرني عندما كنت تتحدى بان برنامجك - اقصد البرنامج المجمع " الموظفين " - لا يستطيع احد اختراقه ها أنت قد تنازلت عن رأيك واعترفت بانه يمكن اختراقه . وقبل يومين فقط كنت لا تصدق ذلك . الم أقل لك بان لا شيء مستحيل في عالم الكمبيوتر
  21. السلام عليكم ورحمة الله وبركاته اعمل على اوفيس 2003 ويفتح معي البرنامج ولكني لم اقم بتجربته بفضل اداة تحويل الملفات من 2007 الى 2003 دمت بود
  22. السلام عليكم هذا البرنامج غير مسجل لذلك لا يتعرف على كلمة اطول من اربع حروف فقط وبعد تسجيل البرنامج اعتقد بأنك تستطيع استخدامه بشكل سهل وكل ما عليك هو فتح الملف المحتوي على كلمة السر ولتبع الخطوات على الشاشة دمت بود
  23. السلام عليكم ورحمة الله وبركاته أما سؤالي عن طريق الحماية فأعرف البرنامج الذي استخدمته وهناك مشاركة لأخ يسأل عن هذا البرنامج واني منتظر ردك عليه حتى تفيده ولكن اعرف طريق الحماية والأكواد كلها مكتوبة عن طريق الاخوة خبور وابوتامر وأنا ساجد طريقة لفك تشفير برنامج lockxlsrtm والبرنامج الذي استخدمته للحماية سهل جداً فيكفي أن تفتح مجلد جديد وتضع فيه ملفات اكسيل ثم تختار طريقة الحماية بكلمة سر أو حماية الوحدات النمطية واخفائها وهناك مميزات كثيرة لهذا البرنامج مثلا تستطيع ان تجعل كلمة سر لأيام محددة وأكثر من طريقة للحماية . وأنا لم اهاجمك ولكني تحدثت معك بصدق دمت بود
  24. السلام عليكم ورحمة اله وبركاته الأخ ALMAISTRO تحية طيبة وبعد الاخ M.slash سأل كيفية الاستفادة من برنامج الحماية فأراك وقد احلته الى المشاركة الثامنة وأعرف بأنها لن تكون كافية للأجابة على سؤاله وأرى أخي بأنك تطرح موضوع للمناقشة فما ان تعرف الطرق والحيل المختلفة من الخبراء حتى تجمع أعمال غيرك وتضعها مشفرة لكي لا يستفيد منها غيرك فكان الأجدر بأن توسد الامر لأهله وتضع البرنامج مفتوح المصدر كعادة العظماء في هذا المنتدى حتى يتسنى للجميع وتعم الفائدة ولا تكن ...... دمت بود وآسف على الصراحة
×
×
  • اضف...

Important Information