دورة شرح الفيجول بيسك للتطبيقات VBA

[عبدالله المجرب]

ان شاء الله ساقوم في الغد بحل السؤال ان لم يجد من يجي عليه

[عبدالله المجرب]

السلام عليكم

اخواني الكرام هذا حل للسؤال الخاص بدالة تقريب

الدالة بها طريقتين للتقريب

الاولى اذا كان بعد الفاصلة رقم واحد مثل 1.6 او 1.9 او 1.3 سيتم التقريب الى التالي

1. اذا كان اقل من 5 سيصبح الرقم بدون تقريب مثل

1.3 سيصبح 1

99.4 ستصبح 99

2. اذا كان يساوي 5 لن يتم الاتقريب

3. اذا اكثر من 5 ستم زيادة 1 مثل

6.6 ستصبح 7

==========

الحالة الثانية وهي اذا كان الرقم بعد الفاصلة من رقمين سيتم التقريب بنفس الحالة الاولى لكن الى الرقم الاول بعد الفاصلة

هذا هو كود الدالة

Function RoudFun(MyCel As String)

If MyCel = Empty Then RoudFun = "": Exit Function

MyCel_Int = Int(MyCel)

MyCel2 = Round(MyCel - MyCel_Int, 3)

If Len(MyCel2) = 1 Then RoudFun = MyCel: Exit Function

If Len(MyCel2) = 3 Then

Select Case MyCel2

Case 0 To 0.4:

RoudFun = MyCel_Int

Case 0.5 To 0.5:

RoudFun = MyCel_Int + 0.5

Case 0.6 To 0.9:

RoudFun = MyCel_Int + 1

End Select

End If

If Len(MyCel2) = 4 Then

Select Case Val(Mid(MyCel2, 4, 1))

Case 0 To 4:

RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3))

Case Is = 5:

RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) + "0.0" & Val(Mid(MyCel2, 4, 1))

Case 6 To 9:

RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) + "0.1"

End Select

End If

End Function

وهذا هو المرفق

RoudFun.rar

[الشهابي]

الأستاذ القدير / أبو أحمد

هذا كود يصعب على أمثالنا فهمه فكيف بعمل مثله

ممكن شرح لهذه الدالة من غير كلف أستاذنا القدير

نحن نعرف مشاغلك واهتمامك الكبير بما يطلبه الأعضاء

فلا نريد أن نكلفك أكثر

والعفو

وجزاك الله خير ( أستاذ كبير وقلب كبير )

[الشهابي]

أستاذنا الكبير/ عبد الله المجرب أبو أحمد

أستأذنك في شرح دالة RoudFun ( دالة التقريب) التي عملتها أنت

وإن شاء الله أن أكون موفق في شرحها

وأرجو منكم تصحيح الأخطاء جزاكم الله خير

فلنبدأ الشرح

Function RoudFun(MyCel As String)

في هذا السطر تم عمل الدالة باسم RoudFun ولها بارومتر واحد وهو المتغير MyCel وتم تعريفه من نوع String أي نص

If MyCel = Empty Then RoudFun = "": Exit Function

في هذا السطر وضع شرط بدالة If وهو أنه إذا كانت الخلية المستهدفة فارغة تكون نتيجة الدالة فارغة ثم الخروج من الدالة

MyCel_Int = Int(MyCel)

في هذا السطر تم وضع متغير باسم MyCel_Int وهو يساوي الرقم الصحيح فقط للرقم الكسري الموضوع في في MyCel بارومتر الدالة

MyCel2 = Round(MyCel - MyCel_Int, 3)

هنا تم وضع متغير باسم MyCel2 وهو يساوي تقريب MyCel لثلاث خانات ناقص الرقم الصحيح لـ MyCel والنتيجة هي الكسر مكون من ثلاث خانات أو أقل إذا كان الرقم خاناته أقل من ثلاث

If Len(MyCel2) = 1 Then RoudFun = MyCel: Exit Function   

هنا إذا كان عدد السلسة النصية في نتيجة المتغير MyCel2 مكونة من رقم واحد فنتيجة الدالة تساوي نفس الرقم ومن ثم الخروج من الدالة

If Len(MyCel2) = 3 Then

هنا إذا كان عدد السلسة النصية في نتيجة المتغير MyCel2 مكونة من ثلاثة أرقام فقم بتنفيد الآتي :

Select Case MyCel2

هنا تم استعمال Select Case مع المتغير MyCel2

Case 0 To 0.4:

RoudFun = MyCel_Int

هنا إذاكان نتيجةالمتغير MyCel2 من صفر إلى أربعة فإن نتيجة الدالة تساوي نتيجة المتغير MyCel_Int المحددة أعلاه

Case 0.5 To 0.5:

RoudFun = MyCel_Int + 0.5

هنا نتيجة الدالة تساوي نتيجة المتغير MyCel_Int زايد 0.5 أستاذ عبد الله على الرغم من إعجابي بالفكرة بس مارأيك بهكذا

Case 0.5 To 0.5:

RoudFun = MyCel

Case 0.6 To 0.9:

RoudFun = MyCel_Int + 1

End Select

End If

هنا إذا كان MyCel2 من ستة من عشرة(0.6) إلى تسعة من عشرة (0.9) فإن النتيجة تساوي MyCel_Int زايد 1 ومن ثم إنها Select Case وإنهاء الدالة If

If Len(MyCel2) = 4 Then

هنا إذا كان عدد السلسة النصية في نتيجة المتغير MyCel2 مكونة من أربعةأرقام فقم بتنفيد الآتي :

Select Case Val(Mid(MyCel2, 4, 1))

Case 0 To 4:

RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3))

تم استخدام دالتين دالة Val مع دالة Mid لتحديد العدد الرابع في MyCel2 هنا إذا كان عددواحد من بدايةالعدد الرابع في السلسة النصيةMyCel2 وترتيبه هنا سوف يكون 4 في السلسة نتيجته من صفر إلى أربعة فإن نتيجة الدالة تساوي نتيجة المتغير MyCel_Int زايد ثلاثة أرقام في MyCel2 من بداية السلسلة وهي مثلاً (0.0)

Case Is = 5:

RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) + "0.0" & Val(Mid(MyCel2, 4, 1))

إذا كانت نتيجة Val(Mid(MyCel2, 4, 1)) تساوي خمسة فإن النتيجة تساوي MyCel_Int زايد ثلاثة أرقام في MyCel2 زايد " 0.0" مع الرقم الرابع في MyCel2 وتم وضع ( "0.0")حتى يكون موضع الرقم في السلسة 4 أي موضعه نفسه مع عدم تغير في الأرقام السابقة وهنا لا يتم تغير شيء

Case 6 To 9:

RoudFun = MyCel_Int + Val(Mid(MyCel2, 1, 3)) + "0.1"

End Select

End If

End Function

هنا إذا كانت نتيجةVal(Mid(MyCel2, 4, 1)) من 6 إلى 9 فإن النتيجة تساوي نتيجة المتغير MyCel_Int زايد ثلاثة أرقام في MyCel2 من بداية السلسلة زايد "0.1" هنا يتم إضافة رقم 1 إلى الرقم الثالث في السلسة فيزيد بمقدار واحد ومن ثم إنها Select Case وإنهاء الدالة If و إنتهاء الدالة المستحدثة Function أستأذي عبد الله ما رأيك لو كان السطر

 If Len(MyCel2) >= 4 Then

فمهما زادت الأعداد بعد الفاصلة عن ثلاثة أرقام تكون النتيجة نفسها

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

أعتذر عن الشرح اللمل فهو شرح متعلم وهذا الشرح لي ولإمثالي من المبتدئين في هذا المجال

لأنني طلبت منك أستاذي الشرح

ولكن حاولت أن أفهم الدالة بنفسي وإن شاء الله يكون فهمي سليما

أعتذر مرة أخرى عن الإطالة

تلميذكم الشهابي

[عبدالله المجرب]

فهمك سليم 100%

بارك الله فيك اخي الشهابي واعذرني على عدم شرحي للدالة فقد نسيت

[الشهابي]

<p>

بارك الله فيك اخي الشهابي واعذرني على عدم شرحي للدالة فقد نسيت 

</p>

<p><strong>أستاذنا / أبو أحمد </strong></p>

<p><strong>عذرك مقبول و إن لم تعتذر </strong></p>

<p><strong>بالعكس تسيانك ساعدنا في الوصول إلى محاولة الفهم بأن

[عبدالله المجرب]

بعد إعتذار الاستاذ معتصم عن شرح هذا الجزء نتيجة لظروف نسال الله ان ييسرها عليه

اليكم شرح الجزء الاول من الفصل السابع الخاص بالدوال صندوقي الرسائل والادخال واستخدام التاريخ والوقت وتحديد عدد الايام والوقت بين تاريخين

[الـعيدروس]

السلام عليكم

الاستاذ القدير عبدالله المجرب حفظك الله ورعاك

حقيقة موضوع مميز وكلنا نستفيد منه

لك منا كل الشكر والتقدير

نسأل الله ان يوفقك دنيا واخره

وهذه دالة التقريب ربما اكون اصبت

Function ALI_I(A As Double) As Double

Dim A_1 As Long

Dim A_2 As Double

Dim A_3 As Double

A_1 = Int(A): A_2 = A - A_1

A_3 = A

Select Case A_2

		    Case Is < 0.5

		    ALI_I = A_1

		    Case Is = 0.5

		    ALI_I = A_3

		    Case Is > 0.5

		    ALI_I = A_1 + 1

End Select

End Function

تقبلو تحياتي وشكري

[ياسر أحمد الشيخ]

السلام عليكم ورحمه الله وبركاته

عمل أكثر من رائع يا جماعه

ولكن لى سؤال بخصوص input box

>>>>> مربع inputbox يحتوى على زرين ok,cancel

- كيف يمكننى تنفيذ كود ما عند الضغط على ok

- وعند الضغط على cancel يتم انهاء الكود

أرجو التوضيح بمثال

مع العلم أننى قمت بتنفيذ الفكرة على مربع msgbox وشغاله 100%

ولكن عند التنفيذ على مربع inputbox يعطينى خطأ

وشكرا جزيلا

[عبدالله المجرب]

ولكن لى سؤال بخصوص input box

>>>>> مربع inputbox يحتوى على زرين ok,cancel

- كيف يمكننى تنفيذ كود ما عند الضغط على ok

- وعند الضغط على cancel يتم انهاء الكود

أرجو التوضيح بمثال

جرب هذا الكود

Sub bbb()

A = InputBox("ادخل القيمة التي تريد", "تنبيه", 1)

If Not A <> Empty Then Exit Sub

Cells(1, 1) = A

End Sub

[أ / محمد صالح]

تحية طيبة لكل أحبابي

أعضاء ومشرفي منتدى أوفيسنا

بيتنا الثاني جميعاً

عذرا لغيابي عنكم في الفترة الأخيرة

نظرا لانشغالي بأعمال امتحانات نهاية العام في عملي

واليوم موعدنا مع الفصل الثامن من الدورة وهو يخص تصحيح الأخطاء

وهذا هو الجزء الأول الخاص بأنواع الأخطاء

وبإذن الله سيتم رفع الجزء الثاني قريبا جدا

وفقنا الله وإياكم لكل ما يحبه ويرضاه

ولا ينقصني سوى دعاؤكم

[عبدالله المجرب]

ما شاء الله

الله يديم عليك النعمة ويبارك فيك

[رجب جاويش]

بارك الله فيك أستاذ محمد

وجزاك الله عنا خير الجزاء

[معتصم محمد]

بارك الله فيك استاذنا محمد

وجعله في ميزان حسناتك

[أ / محمد صالح]

أشكر جميع من شاهد ورد على الجزء الأول من الفصل الثامن

وها هو الجزء الثاني كما وعدتكم

ومرفق الملف الذي تم العمل عليه

وبه هدية خفيفة أتمنى أن تنال إعجابكم

وفقنا الله وإياكم لكل ما يحب ويرضى

تصحيح الأخطاء debugging.rar

[ابو تميم]

جزاك الله خيرا أخي الاستاذ القدير محمد صالح

[abouelhassan]

كل الشكر والتقدير والاحترام من اخيك استاذنا

[محمد مصطفى ابو حمزة]

بارك الله فيكم أساتذتنا

وجزاكم الله عنا خير الجزاء

[مدريدي عمان]

السلام عليكم ورحمة الله وبركاته اردت المشاركة في هذا العمل الخير

وذلك بشرح بعض الدروس النظرية بطريقة مرئية

وهنا اود الاستئذان من الاساتذة الكرام الذين يقومون بشرح الدروس باعادة شرحهم بالطريقة المرئية

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

[alfahad]

بارك الله فيكم

وجزاكم خير

[ابو سجى]

بارك الله فيكم جميعاً

ولكن ارجوا منكم اعادة رفع فيديوهات الشرح

ولكم وافر التقدير

[ابو سجى]

بارك الله فيكم جميعاً

ولكن ارجوا منكم اعادة رفع فيديوهات الشرح

ولكم وافر التقدير

لقد قمت بتحميل البرنامج

شكرا

[ahmad.saeed.mh]

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

[althaer]

السلام عليكم ورحمة الله وبركاته

جزيل الشكر والتقدير لكم و لكل أعضاء المنتدى الموقرين

لدى سؤال أستاذ عبدالله هل يمكن عمل الترحيل لبند أو بنود معينة حسب الإختيار من شيت إلى آخر بنفس الملف بمجرد الضغط على علامة صح بجوار البند

أرجوا المعذرة لأنى جديد فى هذه التطبيقات

[مرعى السيد]

بارك الله فيكم على هذا الأثراء الطيب

وأدعو لكم بالتوفيق والمزيد