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

اخوانى واحبتى فى الله اقدم شرح الاداه نايس بانل لمن يريد ان يستخدمها جزاه الله كل خير صاحب الشرح وفقكم الله لما يحب ويرضى احبكم فى الله شرح الأداة NicePanel.rar

اكتب هذه المعادلة =SUM('1:31'!A1)/COUNT('1:31'!A1) حتى تقتنع بوجهة نظرى اليك هذا المثال انظر الى الصفحة total Book1 salim.rar

بعد اذن اخي عبد السلام كود مختصر Sub show_borders() With Selection.Borders .LineStyle = xlNone .LineStyle = xlContinuous End With With Selection.SpecialCells(xlCellTypeConstants, 23).Borders .LineStyle = xlContinuous .Weight = xlThin End With End Sub

يمكنك العمل على هذا الملف كبداية الصفحة الاولى توزيع افقي (حاول تغديل الرقم في الخلية J1 أو K1 ) الثانية توزيع عامودي Distribute Hor_or_Ver.rar

جرب هذا الملف (بعد اذن اخي ابو عبد الباري) masarif.rar

ارجو ان يفى الملف التالى بالغرض abo_abary_جمع شرطى.rar

الموضوع : كود ترحيل البيانات بشكل مميز سأتناول أولا : شرح الكود حتى يسهل على الجميع أستخدامة داعيا الله ان يوفقنى الى ما يحبة ويرضة أ - سأقوم بدرب مثال يفضل ان تنفذة معى لكى تصل لكيفية عمل الكود وتطويعه لما تريد عملة أبدأ بفنح ملف أكسيل جديد : قم بتسمية ورقة العمل الاولى بأسم ادخال بيانات والورقة الثانية فواتير ثم فى صفحة العمل الاولى والتى تسمى بـ ادخال البيانات قوم بتصميم جدول كما هو موضح فى الصورة ثم تصميم زر فى نفس الصفحة حتى يصبح بنفس الشكل هذا لم لا يعرف كيفية تصميم زر يمكنة ذلك من خلال : ----------------------------------------------------- اصدار 2003 من مربع أدوات التحكم > ادارج زر ------------------------------------------------------ اصدار 2007 من المطور > ادراج زر ------------------------------------------------------- وفى الصفحة الثانية التى تم تسميتها باسم فواتير نصممها على هذا الشكل بعد تصميم تسمية الصفحتين والزر فى الصفحة الاولى يمكنك اضافة الكود من خلال اختيار وضع التصميم والضغط على الزر الذى سبق تصميمة دبل كليك ايسر على الماوس ثم نضع الكود التالى وسأقوم بشرحة تفصيليا كما بالصورة (الكود مرفق ) الجزء الاولى من الكود الجزء الثانى من الكود الجزء الثالث من الكود الجزء الرابع من الكود الجزء الخامس من الكود الجزء السادس والأخير ملاحظة : الكود يرحل بترتيب الادخال . لتحميل الشرح مصور + ملف المثال + الكود من هنا فى النهاية أسالكم الدعاء اذا افادكم ذلك

=IF(AND(I7="غ";R7="غ";AJ7="غ";BZ7="غ";'بيانات المدرسة'!$B$12<4);1;IF(AND(I7="غ";R7="غ";AA7="غ";AJ7="غ";AU7="غ";BZ7="غ";'بيانات المدرسة'!$B$12>3);1;0)) اعتقد ان هذة المعادلة هى المناسبة بعد توضيحك السابق اما بالنسبة للمعادلة الخاصة بالأستاذسليم حاصبيا فلم تؤدى المطلوب منها كما فهمت

Sub BorderCells() Dim rng As Range Selection.Borders(xlEdgeLeft).LineStyle = 0 Selection.Borders(xlEdgeTop).LineStyle = 0 Selection.Borders(xlEdgeBottom).LineStyle = 0 Selection.Borders(xlEdgeRight).LineStyle = 0 Selection.Borders(xlInsideVertical).LineStyle = 0 Selection.Borders(xlInsideHorizontal).LineStyle = 0 For Each rng In Selection If Len(rng) <> 0 Then rng.Borders(xlEdgeLeft).LineStyle = 1 rng.Borders(xlEdgeTop).LineStyle = 1 rng.Borders(xlEdgeBottom).LineStyle = 1 rng.Borders(xlEdgeRight).LineStyle = 1 End If Next End Sub الكود يطبق علي الخلايا المحددة .. يمكن استبدال السليكشن بالنطاق المراد تطبيق الكود عليه

جزاك الله خيرا اخي سليم حاصبيا وبارك الله فيك

عدلها الى db as dao.database بالتوفيق

الأخ العزيزyathreb بعد التحية ارجو ان يفى الملف بالغرض abo_abary_الرابع.rar

مشكور هل ادى الملف الغرض

اوفيس 7 فيه ماس وان شئت قل مس اسف على التعميم ليس الاوفس بل هو اكسس 7 فانا لا اعتمده في اعمالي اقوم بتركيب 3 او 10 اكثر من مرة سبب لي احراج ما قولك في برنامج اعمله على 3 وعند التشغيل على 7 يهنق ولا يعمل حتى اغلقه واعيد فتحه مرة اخرى والطامة في بعض الاحيان يمتنع كليا من تشغيل ملفات mde حتى تقوم بتحويلها من نسخة 7 نفسها وهذا يعني اخذ الحيطة دائما يكون معك نسخة من اصل البرنامج ، اما اكسس 10 فلا توجد فيه هذه المشاكل وتنحصر مشكلته مع العملاء في رقم النسخة والتسجيل واعتقد ان 13 مشابه لـ 10 مع مشكللة مررت بها وهي امتناع ظهور القوائم وشريط الادوات الذي يوفره اكسس 2003

طلبك غريب نوعا لان الشهر الكامل اكمل واجمل وهذا يعني ان اجابة اخونا الوزير نموذجية ولو كان العمل لي لاخذت بها ما علينا اعمل ثلاث حقول في النموذج txt3 ، txt2 ، txt1 وفي حدث بعد التحديث للحقل txt1 الصق هذا الكود Dim kdate As Date kdate = 15 & "/" & txt1 & "/" & Format(Date(), "yyyy") txt2 = txt1 & "_" & "01" txt3 = txt1 & "_" & Format(DateSerial(Year(kdate), Month(kdate) + 1, 0), "dd") txt1 هو الحقل الذي ستكتب فيه رقم الشهر مع الاخذ بالاعتبار ان النتيجة ستكون محصورة في السنة الحالية db1.rar

تفضل تم عمل المعايير اللازمة ولكن لاحظ اني عملت نموذجا خاصا لذلك sum_time7.rar

الله عليكم رائع بس لو تخصصون نصف ساعة من وقتكم الثمين لتعليم المبتدئين من مثلي دروس vba (سلسلة تشرح كل يوم كود ) كود لا دوال الأكسس لأنها موجودة خاصة تراكيب الكود و بعض الرموز التي تأتي معه & " ' "'" ";" و شوف كم يضاعف الأجر للأسف نحن لم نجد معاهد تكوين متخصصة تمكننا من ذلك كل ما تعلمناه هو من الأنترنت لكن تبقى ناقصة و الكتب كلها إنجليزي فاياريت تبسط لنا الأمور حتى نتحكم فيها و يزول الغموض و الله أنا بغير منكم و في قلب حسرة أني لم أستطيع التقدم في هذا المجال و الله أنتم طوبى لكم و شكرا

جرب الملف التالى لعلة يفى بالغرض abo_abary_ استخراج الأوائل بالمواد.rar

السلام عليكم كل سنة وانت طيب استاذ عبدالرحمن اعتذر لتأخري في الرد والسبب اني انسيت الموضوع ، ولو ذكرتني على الخاص لكان احب الي واعتذر ايضا اني لم انتبه الى المثال المرفق في حينه واليوم هكذا دخلت بالصدفة واطلعت على المثال بالنسبة للرموز فيوجد طريقة ذكية للاستبدال وتستطيع تجربتها على نسخة من العمل للأمان حتى تتقن العملية ثم تطبقها على المشروع الأصلي وهي : اولا ادرج رمز (صلى الله عليه وسلم ) في اي مكان من الصفحة 1-حدد الرمز ( علامة الاستفهام) ثم انسخه ثم تفتح البحث والاستبدال وفي خانة البحث تلصق مافي الذاكرة 2- ارجع الى الصفحة وانسخ رمز (صلى الله عليه وسلم ) 3- ضع المؤشر في خانة استبدال بـ 4- انقر على زر : أكثر ثم انقر على زر : خاص 5- اختر القيمة : محتويات الحافظة الآن قم باجراء عملية الاستبدال ( يمكنك استبدال الكل بضغطة واحدة ) اما بالنسبة للآيات : فالخط هو خط البسملة والخطوط التابعة له من Qcf_p001.TTF الى Qcf_p604.TTF والملاحظ انها لا تقرأ الكتابة آليا جرب وحدد (ظلل) احدى الآيات المختلة ثم طبق عليه احد خطوط القران المذكورة اعلاه ستجد انها تظهر والسؤال لماذا لا تظهر آليا واعتقد اما ان السبب عدم تعرف الخط على النص اي لا يوجد رابط بينها حيث يتم تطبيق اي خط عليها او اني لم اثبت كامل الخطوط .. لا حظ ان الخطوط بعدد صفحات القرآن ، وهذا يعني ان اللآيات مكتوبة مسبقا والعمليه هي ادراج هذه الآيات من ملفات الخطوط كتبت لك تجربتي على عجالة وان شاء الله سأبحث عن حل افضل ولعلك تسبقني اليه

اخى الكريم ارفق مثالا او استعمل الدالة NZ وهي اختصاراً لكلمتي : NULL Zero ومهمتها أن يتم التخلص من مشكلة وجود القيمة Null في بعض العمليات مما يعطي خطأ .. صيغتها كما يلي : A = NZ(B,0) أو A = NZ(B) S = NZ (V,"") ومن هذا يتضح أن لهذه الدالة ممران 1- القيمة المطلوب فحصها 2- القيمة المعادة في حال كون القيمة الأولى Null وفي حال عدم تعيين القيمة الثانية تعيد لنا هذه الدالة القيمة صفر في حال كون القيمة الأولى Null

تفضل أخي الكريم اشرف التعديل الأخير Public Function Wish(RngData As Range, RngWish As Range, Start_WishColumn As Long, End_WishColumn, MarkColumn As Long, MinimumMark As Single) 'البارامتر الأول يمثل نطاق البيانات بالكامل 'البارامتر الثاني يمثل نطاق الرغبات والحد الأقصى المسموح به 'البارامتر الثالث يمثل رقم عمود بداية الرغبات ضمن النطاق 'البارامتر الرابع يمثل رقم عمود نهاية الرغبات ضمن النطاق 'البارامتر الخامس يمثل رقم عمود الدرجات ضمن النطاق 'البارامتر السادس يمثل الدرجة الصغرى والناتج يكون بدون توجيه '=Wish(D8:R27,U12:V23,3,14,15,10) '----------------------------------------------------------- Dim ArrData, ArrWish, ArrOut, ArrSwap Dim ColCount As Long, I As Long, J As Long, K As Long ArrData = RngData.Value ArrWish = RngWish.Value For I = 1 To UBound(ArrWish, 1) ArrWish(I, 2) = ArrWish(I, 2) Next I ReDim ArrOut(1 To UBound(ArrData, 1), 1 To 1) ColCount = UBound(ArrData, 2) ReDim ArrSwap(1 To 1, 1 To ColCount) For I = 1 To (UBound(ArrData, 1) - 1) For K = I To UBound(ArrData, 1) If ArrData(K, MarkColumn) > ArrData(I, MarkColumn) Then For J = 1 To ColCount ArrSwap(1, J) = ArrData(I, J) ArrData(I, J) = ArrData(K, J) ArrData(K, J) = ArrSwap(1, J) Next J End If Next K Next I For I = 1 To UBound(ArrData, 1) If ArrData(I, MarkColumn) < MinimumMark Then ArrOut(I, 1) = "بدون توجيه" Else For J = Start_WishColumn To End_WishColumn If ArrOut(I, 1) = "" Then For K = 1 To UBound(ArrWish, 1) If ArrData(I, J) = ArrWish(K, 1) Then If ArrWish(K, 2) > 0 Then ArrOut(I, 1) = ArrWish(K, 1) ArrWish(K, 2) = ArrWish(K, 2) - 1 End If End If Next K End If Next J End If Next I For I = 1 To (UBound(ArrData, 1) - 1) For K = I To UBound(ArrData, 1) If ArrData(K, 1) < ArrData(I, 1) Then ArrSwap(1, 1) = ArrData(I, 1): ArrSwap(1, 2) = ArrOut(I, 1) ArrData(I, 1) = ArrData(K, 1): ArrOut(I, 1) = ArrOut(K, 1) ArrData(K, 1) = ArrSwap(1, 1): ArrOut(K, 1) = ArrSwap(1, 2) End If Next K Next I Wish = ArrOut End Function

أخي الكريم أشرف .. وهشام كمال الأخ الحبيب المتابع للموضوع من بدايته أخي وحبيبي علاء رسلان إليكم إصدار أفضل من الدالة المعرفة .. وبالمثال يمكنكم التعامل مع أي بيانات إن شاء الله Public Function Wish(RngData As Range, RngWish As Range, Start_WishColumn As Long, End_WishColumn, MarkColumn As Long) Dim ArrData, ArrWish, ArrOut, ArrSwap Dim ColCount As Long, I As Long, J As Long, K As Long ArrData = RngData.Value ArrWish = RngWish.Value For I = 1 To UBound(ArrWish, 1) ArrWish(I, 2) = ArrWish(I, 2) Next I ReDim ArrOut(1 To UBound(ArrData, 1), 1 To 1) ColCount = UBound(ArrData, 2) ReDim ArrSwap(1 To 1, 1 To ColCount) For I = 1 To (UBound(ArrData, 1) - 1) For K = I To UBound(ArrData, 1) If ArrData(K, MarkColumn) > ArrData(I, MarkColumn) Then For J = 1 To ColCount ArrSwap(1, J) = ArrData(I, J) ArrData(I, J) = ArrData(K, J) ArrData(K, J) = ArrSwap(1, J) Next J End If Next K Next I For I = 1 To UBound(ArrData, 1) For J = Start_WishColumn To End_WishColumn If ArrOut(I, 1) = "" Then For K = 1 To UBound(ArrWish, 1) If ArrData(I, J) = ArrWish(K, 1) Then If ArrWish(K, 2) > 0 Then ArrOut(I, 1) = ArrWish(K, 1) ArrWish(K, 2) = ArrWish(K, 2) - 1 End If End If Next K End If Next J Next I For I = 1 To (UBound(ArrData, 1) - 1) For K = I To UBound(ArrData, 1) If ArrData(K, 1) < ArrData(I, 1) Then ArrSwap(1, 1) = ArrData(I, 1): ArrSwap(1, 2) = ArrOut(I, 1) ArrData(I, 1) = ArrData(K, 1): ArrOut(I, 1) = ArrOut(K, 1) ArrData(K, 1) = ArrSwap(1, 1): ArrOut(K, 1) = ArrSwap(1, 2) End If Next K Next I Wish = ArrOut End Function يتم تحديد النطاق الذي تريد النتائج به S8:S27 ثم في شريط المعادلات ضع المعادلة التالية =Wish(D8:R27,U12:V23,3,14,15) ثم اضغط على Ctrl + Shift + Enter البارامترات الخاصة بالمعادلة : البارامتر الأول : نطاق البيانات بالكامل D8:R27 البارامتر الثاني : نطاق الرغبات والذي يحتوي على الرغبات والحد الأقصى المسموح به البارامتر الثالث: عمود بداية الرغبات وهو في المثال العمود رقم 3 والعد يبدأ من بداية نطاق البيانات .. أي أن العد في المثال يبدأ من العمود D البارامتر الرابع: عمود نهاية الرغبات وهو في المثال العمود رقم 14 وكما أخبرنا العد يبدأ من بداية نطاق البيانات البارامتر الخامس والأخير: هو رقم عمود المجموع وهو في المثال رقم 15 وكما أخبرنا ونؤكد أن العد من بداية نطاق البيانات لا تنسونا من صالح دعائكم Pupils Distribution According To Marks & Wishes V2.rar

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

السلام عليكم ورحمة الله أخي الكريم، حذف الصفوف أو الأعمدة بالمعادلات فقط غير ممكن البتة (ويمكن يدويا)، لا بديل عن الكود في مثل هذه الحالات... الرجاء وضع مثال لملف يمكن تطبيق الكود عليه... أخوك بن علية

بسم الله الرحمن الرحيم برنامج كشـف صـرف النقـديـة بالفئـات المتـاحـة نسخة تعمل على اكسيل 11 ( 2003 ) المرفقات عبارة عن ::: 1 - ملف البرنامج وبه شرح لطريقة عمله 2 - ملف فيديو لطريقة عمل البرنامج أتمنى صالح الدعاء Omar.rar برنامج كشـف صـرف النقـديـة بالفئـات المتـاحـة نسخة تعمل على اكسيل 12 ( 2007 ) تم استبدال الايقونات بأزار فقط يرجى الاطلاع على تعليمات التشغيل لآكسيل 12 بداخل الملف المرفق _______________________________________________12__.rar

بسم الله الرحمن الرحيم برنامج خبور المحاسبي الاصدار الاول ( استخدام عملة واحدة) محاولة متواضعة لعمل برنامج محاسبي بالماكرو بقاعدة بيانات 15000 سجل قام بمراجعة الماكروهات في البرنامج الاخ العزيز عمر الحسيني ومن خلاله اقدم الشكر الجزيل للاخ عمر واقول له من علمني حرفا كنت له عبدا التعليمات داخل البرنامج ارجوا من الله تعالى ان تستفيدوا منه وتقبلوا مني فائق الشكر والتقدير اخوكم خبور اذا لديكم اي اقتراحات او اضافات ستساعد على فعالية البرنامج كلنا اذان صاغية _____________________1.rar