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

السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الحبيب سبق أن قدمت في موضوع سابق دالة مشابهة لدالة اليوم ، ولكن دالة اليوم مميزة من ناحية سنقوم بسردها بعد قليل رابط الموضوع المتعلق بشبيهة الدالة فاصل ونواصل (أصلي تعبت ... ) دا شكل الدالة المعرفة Function GetUnique(R As Range) Dim Cl As Range, J As Long With CreateObject("System.Collections.ArrayList") For Each Cl In R.Cells If Cl <> "" Then If Not .contains((Cl.Value)) Then .Add (Cl.Value) Next .Sort For J = 1 To R.Count .Add ("") Next J GetUnique = Application.Transpose(.toarray()) End With End Function ايه رأيكم في شكلها (أنا شايف إنها شكلها لطيف ...مش كدا يا أبو يوسف) تقوم الدالة المعرفة UDF والتي تسمى GetUnique ، باستخراج القيم الغير مكررة في نطاق أي القيم الفريدة في نطاق ، والجديد والمفيد أنه يمكن ترتيب القيم لتحصل في النهاية على قائمة منقحة ومصححة وخالية من التكرار والفراغات .. كل دا بضربة واحدة (ضربة معلم ..صح يا حوسو) إذاً وظيفة الدالة : الحصول على قيم فريدة اي غير مكررة - ترتيب النتائج ترتيب أبجدي - التخلص من الفراغات الموجودة في القائمة الأصلية وبالمثال المرفق سيتضح المقال كيفية عمل الدالة : بفرض أن القيم المراد استخراج القيم الفريدة منها في العمود الأول في النطاق A1:A30 نشوف العمود اللي عايزين نستخرج النتائج فيه وليكن العمود G .. اشمعنا العمود دا بالذات ، عشان العمود ده رقم 7 وأنا من عشاق الرقم 7 ومضاعفاته .. نحدد النطاق من أول الخلية G1 لحد G30 قبل ما نكتب المعادلة حددنا النطاق (برافو عليك يا حوسو) روح بقا لشريط المعادلات (مش ظاهر معاك يبقا أكيد لعبت في إعدادات الإكسيل .. ودي حاجة مش وحشة دي حاجة حلوة ، لأنها دليل إنك عايز تتعلم .. اظهر شريط المعادلات من التبويب View هتلاقي كلمة Formula Bar جنبه مربع علم عليه ..! مش أحسن ما هو اللي يعلم عليك) ضع المعادلة التالية في شريط المعادلات =GetUnique(A1:A30) ومن لوحة المفاتيح اضغط Ctrl + Shift + Enter لأن دي معادلة صفيف .. ومبروك عليك القايمة الجديدة (على أساس إنك متجوز للمرة التانية .. بس القديمة تحلا ولو كانت أحلى ..بلاش نقول وحلة لناخد مخالفة (من خاف سلم)) طيب دلوقتي أنا سامع واحد بيقولي إنت ليه بتجبرني إني أرتب القيم (أنا عايز القيم زي ما هي بدون تكرار وبدون فراغات بس الترتيب ميلزمنيش) .. أرد عليه وأقوله ولا تزعل نفسك يا حبيبي روح لمحرر الأكواد ودور على السطر اللي جاي ده واحذفه أو ضع بجانبة تعليق .. بس خلاص ! مش دي اللي هتزعلنا من بعضنا ) .Sort وأخيراً تقبلوا تحيات أخوكم أبو البراء دمتم على طاعة الله Get Unique UDF Function.rar

لعله لمطلوب find salim.rar

اخي مستر ستيف اتوقع لابد ان يكون اللغة موجودة لديك وهنا لاحظ في الريجيستري يوجد الانجليزي ! هل ممكن نحول للعربي الله اعلم هذا الشرح https://msdn.microsoft.com/en-us/library/hh362866%28v=office.14%29.aspx ولي عودة ان شاء الله تحياتي

اعزائي هذا كود رمهاني .. سريع مجاني ..! DoCmd.SetWarnings False Set rs = CurrentDb.OpenRecordset("vtb"): rs.MoveLast: rs.MoveFirst For i = 1 To rs.RecordCount Step 6 Set rs1 = CurrentDb.OpenRecordset("select * from vtb where id between " & i & " and " & i + 5 & " order by id"): rs1.MoveFirst Do While Not rs1.EOF xsql_val = xsql_val & "'" & rs1(1) & "'," rs1.MoveNext Loop xsql_val = Left(xsql_val, Len(xsql_val) - 1) DoCmd.RunSQL "insert into rtb(b1,b2,b3,b4,b5,b6) values(" & xsql_val & ")" xsql_val = "" Next i DoCmd.SetWarnings True اخي ابو منتظر : يمكنك تنفيذ الكود في اي مكان . مثلا خلف زر امر وعند النقر ! مع ملاحظة : لو نفذته اكثر من مرة سيكرر البيانات فيمكن وضع سطر واحد حذف سجلات الجدول قبل تنفيذ الكود ! تحياتي وبالتوفيق

كود اضافة الدوائر الحمرا ويعمل بطريقة فريده يمكنك استخدام تكبير او تصغير العرض بدون التاثير في وضع الدوائر في اماكنها (سيعمل الكود بدون مشاكل) ActiveWindow.Zoom صف الدرجات متغير هنا الصف رقم 12 اذا كانت الخلية في هذا الصف ليست رقم .. لا تتم اضافة دائرة في صفوف عمود الخلية عمود رقم الجلوس العمود متغير هنا رقم 2 اذا كان هذا العمود فاضي او صفر لن تتم اضافة الدوائر تم عمل زر مزدوج لإضافة وحذف الدوائر باسم (الدائرة) Sub اضافة_حذف() On Error Resume Next Dim XX As Shape Set XX = ورقة3.Shapes("الدائرة") With XX.TextFrame.Characters If .Text = "اضافة الدوائر" Then Circles1 .Text = "حذف الدوائر" Else RemoveCircles1 .Text = "اضافة الدوائر" End If End With On Error GoTo 0 End Sub Sub Circles1() Dim C As Range Dim MyRng As Range Dim V As Shape Dim X As Integer Dim G As Integer, R As Integer '================================================ ' عمود رقم الجلوس G = 2 ' صف الدرجات R = 12 ' نطاق الخلايا الذي تريد اضافة الدوائر فيها Set MyRng = Range("N13:BQ47") '================================================= ' اذا كانت النطاقات مختلفة يمكنك الاشارة اليهم بالتالي 'Set MyRng = Range("O13:O47,Q13:Q47,S13:S47") '================================================= X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 1 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "غ" Or C.Value = "غـ") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width - 2, C.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If 1 Next ActiveWindow.Zoom = X Application.ScreenUpdating = True End Sub Sub RemoveCircles1() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp End Sub دعوه طيبه لوجه الله لكل من ساهم في هذه الملف ( عبد الله باقشير ) اضافة و حذف دوائر_2.rar

أتمنى من الله ان تكونوا في تمام الصحة والعافية موضوع بسيط وجديد على البعض وفائدته أنه يعمل إنتقال من الفريمات الموجودة في اليوزر فورم بشكل غير تقليدي وسلس في المثال المرفق يوجد يوزر فورم وبه عدد 2 Frame ويتم الإنتقال من فريم للأخر بزر عادي ولكن طريقة الإنتقال هي موضوعنا الأكواد المستخدمة أكواد الـ UserForm يحتوي على 2 Command Button لإنتقال من فريم للأخر Option Explicit Private Sub CommandButton1_Click() While Frame2.Left > 6 Frame2.Left = Frame2.Left - 10 DoEvents Sleep 10 Wend End Sub Private Sub CommandButton2_Click() While Frame2.Left < 266 Frame2.Left = Frame2.Left + 10 DoEvents Sleep 10 Wend End Sub Private Sub UserForm_Initialize() Me.Width = 262 Frame2.Left = 266 Frame2.Top = 6 End Sub كود مستخدم في Module عادي Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) أتمنى يكون الموضوع خفيف وواضح والمرفق به التطبيق ودمتم في حفظ الله Sliding Form.rar

أحبائي المهتمين في منتدى الإكسيل.. أرفق إليكم طريقة تشغيل ملف اليوتيوب عن طريق الفورم الشرح في رابط الفيديو تشغيل اليوتيوب.rar

بسم الرحمن الرحمن الرحيم السلام عليكم ورحمة الله وبركاته حاله من الواقع العملى-- بالاكسيل بافتراض ان لدى جدول ديون العملاء المستحقه وهذه الديون قد تصل الى 5 سنوات كما فى مجال العقارات .وتوفر لدى جدول ببيانات العملاء والاقساط كما فى الجدول والمطلوب منك هو استخراج بيانات اقساط شهر مايو لعام 2015 الدوال المستخدمه فى الحل دالة : MONTH دالة : YEAR دالة :IF دالة : SMALL دالة : ROW دالة: MATCH دالة : INDEX دالة:IFERROR المعادلة المستخدمه (معادلة صفيف CSE ) { =IFERROR(INDEX(B$10:B$24;MATCH(SMALL(IF((MONTH($C$10:$C$24)=$F$10)*(YEAR($C$10:$C$24)=$G$10);ROW($C$10:$C$24);"");ROW($A1));ROW($C$10:$C$24);0));"")} معادله.rar

شهادة اعتز فيها استاذي العزيز

شكرا اخى ياسر تمت العملية بنجاح اذن لابد من تحديد النطاق بالكامل ثم اضغط ctr+shift+enter اشكرك اخى ياسر داله خطيره

أخي الفاضل سعد هل حددت النطاق بالكامل أولاً ..يجب تحديد نطاق النتائج بالكامل قبل إدراج المعادلة بمعني لو عايز النتائج في النطاق H1:H30 يبقا تحدد النطاق بالكامل وتروح لشريط العنوان وتضع المعادلة ومن لوحة المفاتيح تضغط Ctrl + Shift + Enter أو ارفق ملفك للإطلاع عليه

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

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

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

أخي الحبيب أبو يوسف فصبر جميل والله المستعان على ما تصفون إليك الملف التالي ..مش ملفك على الإطلاق لكن ملف شوفه واطلع عليه وشوف إذا كان طلبك زي كدا ولا طلبك مختلف وإذا كان طلبك مشابه حاول تشوف الملف اتعمل إزاي وتطبقه على ملفك ولو واجهك مشكلة أرجو إعلامنا بذلك تقبل تحياتي Search Using TextBox & AutoFilter.rar

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

المهم اللي يسبق وعلى رأي المثل الأوفيسني (اللي يسبق ياخد أفضل إجابة) ههههههه تقبل تحياتي

الأخ الفاضل إسلام مسلم إليك الملف التالي عله يفي بالغرض Countifs Function.rar

الأخ الكريم مولتو (تصدق جعت لما سمعت اسمك) أهلا ومرحباً بك في المنتدى ونورت .. يرجى تغيير اسم الظهور للغة الزهور اللغة العربية يرجى الإطلاع على هذا الرابط لمعرفة التوجيهات (للضرورة ..إذا كنت ستتعامل مع المنتدى بشكل دائم) http://www.officena.net/ib/index.php?showtopic=60147 يرجى إرفاق ملفك الذي به المشكلة المشكلة بشكل مبدئي سببها الخلايا المدمجة ................................ إذا أزلت الدمج ستحل المشكلة تقبل تحياتي

شكراً جزيلا استاذى الكبير ياسر خليل .. بارك الله فيك

ترحيل بيانات بالقائمة المنسدلة للعلامه عبد الله باقشير والمرفق يوضح اكثر ترحيل عن طريق القائمة المنسدله.rar

في أسفل كل مشاركة تجد كلمة "تحديد كأفضل إجابة" قم باختيار أفضل إجابة لك وانقر على الكلمة .. ومتنساش اسم الظهور للغة العربية لمعرفة كافة ما يرتبط بالتعامل مع المنتدى راجع الرابط التالي (ويا ريت كل الأخوة الجدد يطلعوا على الرابط ... للضرروة) http://www.officena.net/ib/index.php?showtopic=60147

الأخ الفاضل astika أما آن لك أن تقوم بتغيير اسم الظهور للغة العربية يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي

مجهود مشكور اخى إسلام أبو جومانة و بارك الله فيكم و زادكم من علمة

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

الأخ الكريم أحمد أهلا بك في المنتدى يرجى تغيير اسم الظهور للغة الزهور اللغة العربية إليك الكود التالي عله يفي بالغرض Sub ConvertFormulaToVBA() 'لتظهر النتائج في العمود الثالث [=A1(A1-B1)] يقوم الكود بتحويل المعادلة '---------------------------------------------------------------------- Dim I As Long Application.ScreenUpdating = False 'حلقة تكرارية من الصف الأول لآخر صف به بيانات في العمود الأول For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row 'الخلية في العمود الثالث تساوي الخلية في العمود الأول مضروبة في الفرق بين الخليتين Cells(I, 3) = Cells(I, 1) * (Cells(I, 1) - Cells(I, 2)) 'الانتقال للخلية التالية Next I Application.ScreenUpdating = True End Sub يرجى فيما بعد وضع المعادلات بين أقواس التنصيص الخاصة بالكود حتى تظهر بشكل منضبط تقبل تحياتي Convert Formula To VBA.rar

اخي الاستاذ مارد : لم افهم عليك تمام ! هل تقصد ان لديك فكرة حل وتريد ان ننفذها ؟ وحسب فهمي تريد ان تشيك هل المادة موجودة في الفاتورة الحالية ام لا باستخدام عد السجلات ؟ فابشر احنا معا ولكن اتوقع لو تضعها بموضوع جديد افضل ! اخينا احمد وجيه : انا جديد عهد بالمنتديات ومعرفة قوانينها ولكن حسب فهمي انه : يتم الرد على المشاركة لمساعدة السائل في مشكلته فهو من سيفهم الحل مباشرة بدون شرح اما اذا كان هناك شرح لشي معين يتم بموضوع جديد . واسمح لي ان الخص وجهة نظري : 1. لشرح كل مشاركة رد ستحتاج وقت كثير من ما يفقد الرد على اكبر عدد مشاركة ممكن ! 2. كل عضو يسأل بملف وحسب افكاره فاحيانا انا ارد بحل في جزئية معينة ولا افهم باقي السيناريو الذي مشا به فصعب ان اقضي وقت حتى افهم كيف برنامجه يعمل 3.احيطك علما ان الاخ السائل لا يريد الشرح بقدر مايريد الحل 4. من اراد ان يشرح شيئا يذهب لموضوع جديد ويشرح مايريد ! انا ليس لدي الوقت فاغلب وقتي رد على مشاركات ! كما ان هناك سبب وهو عندما اكتب موضوعا جديدا لا بد ان اعطيه حقه او لا اكتب ! 5. تستطيع ان تضع استفسارك حول جزئية معينة اثناء المشاركة ! 6. بعض المشاركات قد تكون الاستفادة منها الفكرة او الطريقة بغض النظر عن طريقة التنفيذ! تحياتي

شكرا أستاذى الرائع " ياسر" التحية كل التحية لأستاذ رائع وجميل بكل أعمالة التى أصبحت تملأ المنتدى بأكملة " كل سنة وحضرتك وكل الزملاء " بألف خير وتحية " بمناسبة هذه الأيام المباركة أعادها الله على الجميع بألف خير تقبلوا تحياتى

بعد إذن أخى" سليم " وجزاكم الله على كل مجهودكم التى تبذلوة فى المنتدى ولأخى السائل أستخدم هذه الصيغة بفرض أن البيانات فى الخلية " A1 " إستخدم هذه الصيغة وأسحبها لأسفل ستحقق المطلوب بإذن الله =ROUNDDOWN(A1/0.5,0)*0.5 تقبلوا تحياتى تقريب رقم.rar

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

بعد التعديل باضافة الميل والمشرفه للجداول والاستعلام والنموذج امممممممممم انا بصراحه مش عارف الميل هيبعت ايه مجربتش على العموم حضرتك جربى تغيرى الميل وتبعتى لنفسك وجربى ووافينى بالنتيجة لان النت سئ جدا جدا جدا عندى ومش عارف اعمل اى شئ 7gz.rar

الأخ الحبيب أبو يوسف بارك الله فيك وجزيت خيراً على كلماتك الطيبة هناك موضوع للأخ ياسين استكمالاً لهذا الموضوع على هذا الرابط ..إن شاء الله يكون فيه فايدة أكبر http://www.officena.net/ib/index.php?showtopic=61626 تقبل تحياتي

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

الأخ الكريم الطاير إذا لم يكن يعجبك الحل بالتنسيق الشرطي (رغم أنه أفضل في هذه الحالة) إليك الحل بالأكواد عله ينال إعجابك Sub HighlightBetweenTwoDates() 'يقوم الكود بتظليل الخلايا طبقاً لتاريخين : تاريخ بداية وتاريخ نهاية '------------------------------------ Dim R As Range 'إعلان المتغير من النوع ثابت ليمثل بداية التاريخ المراد التعامل معه Const myDate As Date = #6/1/2015# 'بدء التعامل مع النطاق المستخدم بدايةً من الصف الخامس لنهاية الصفوف المستخدمة With Intersect(ActiveSheet.UsedRange, Rows("5:" & Rows.Count)) 'إزالة خلفية الألوان بدايةً من العمود السابع وحتى آخر عمود في النطاق المستخدم .Columns("G").Resize(, .Columns.Count).Interior.ColorIndex = xlNone 'حلقة تكرارية لكل خلية من خلايا العمود الخامس For Each R In .Columns("E").Cells 'إذا كانت الخلية داخل الحلقة التكرارية عبارة عن تاريخ وكذلك الخلية المجاورة لها في العمود السادس If (IsDate(R.Value)) * (IsDate(R(, 2).Value)) Then 'R(, DateDiff("D", myDate, R.Value) + 3) 'يمثل هذا الجزء بداية النطاق المراد تظليله ، ويتم حساب فرق الأيام بين تاريخ الخلية والتاريخ الثابت مضافاً إليه 3 ليبدأ من العمود السابع 'Resize(, DateDiff("D", R.Value, R(, 2).Value) + 1) 'يمثل هذا الجزء الامتداد لنقطة البداية بحساب فرق الأيام بين التاريخ في العمود السادس والتاريخ في العمود الخامس R(, DateDiff("D", myDate, R.Value) + 3).Resize(, DateDiff("D", R.Value, R(, 2).Value) + 1).Interior.ColorIndex = 14 Else 'سطر للخروج من الحلقة التكرارية Exit For End If 'الانتقال للخلية التالية في العمود الخامس Next End With End Sub تقبل تحياتي Highlight Vacation Periods.rar

الأخت الفاضلة رشا يوسف جرب المعادلة التالية في الملف التالي وأعلمينا بالنتائج ... =IFERROR(IF(B4="ادارى",LOOKUP(C4,{300;310;320;330;340;350;360;370;380;390;400;410;420;430;440;450;460;470;480;490;500;510;520;530;540;550;560;570;580;590;600;610;620;630;640;650;660;670;680;690;700;710;720;730;740;750;760;770;780;790;800;810;820;830;840;850;860;870;880;890;900;910;920;930;940;950;960;970;980;990;1000;1010;1020;1030;1040},{0;0;0;0;0;0;1;1.25;1.5;1.75;2;2.25;2.5;2.75;3;3.25;3.5;3.75;4;4.25;4.5;4.75;5;5.25;5.5;5.75;6;6.25;6.5;6.75;7;7.25;7.5;7.75;8;8.25;8.5;8.75;9;9.25;9.5;9.75;10;10.25;10.5;10.75;11;11.25;11.5;11.75;12;12.25;12.5;12.75;13;13.25;13.5;13.75;14;14.25;14.5;14.75;15;15.25;15.5;15.75;16;16.25;16.5;16.75;17;17.25;17.5;17.75;18}),IF(B4="مدرس",LOOKUP(C4,{300;310;320;330;340;350;360;370;380;390;400;410;420;430;440;450;460;470;480;490;500;510;520;530;540;550;560;570;580;590;600;610;620;630;640;650;660;670;680;690;700;710;720;730;740;750;760;770;780;790;800;810;820;830;840;850;860;870;880;890;900;910;920;930;940;950;960;970;980;990;1000;1010;1020;1030;1040},{5;5.25;5.5;5.75;6;6.25;6.5;6.75;7;7.25;7.5;7.75;8;8.25;8.5;8.75;9;9.25;9.5;9.75;10;10.25;10.5;10.75;11;11.25;11.5;11.75;12;12.25;12.5;12.75;13;13.25;13.5;13.75;14;14.25;14.5;14.75;15;15.25;15.5;15.75;16;16.25;16.5;16.75;17;17.25;17.5;17.75;18;18.25;18.5;18.75;19;19.25;19.5;19.75;20;20.25;20.5;20.75;21;21.25;21.5;21.75;22;22.25;22.5;22.75;23;23.25;23.5}))),"") توضع المعادلة في الخلية C4 شرائح الضريبة.rar

اخى الحبيب ضع هذا الكود بالفورم هو من اعمال وكنوز اخى الحبيب ابن مصر الغالى المهندس احمد Private Sub UserForm_Initialize() Dim Zo% Dim ZH#, ZW#, AL#, AT#, AH#, AW# Dim FH!, FW! '''''''''''''''''''''' AH = Application.Height: AW = Application.Width AL = Application.Left: AT = Application.Top FH = Height: FW = Width ZH = AH - FH: ZW = AW - FW: Zo = Zoom If ZH < ZW Then Zo = Zo * (AH / FH) Else If ZW < ZH Then Zo = Zo * (AW / FW) '''''''''''''''''''''' Move AL, AT, AW, AH If Zo <> 100 Then Zoom = Zo End Sub تقبل تحياتى

عارف إنك ممكن تكسل تقرا المشاركة اللي فاتت فعملت لك فيديو ع السريع تقبل تحياتي

لا تنشرها جزاك الله خير ... ادخل وحمل وستعرف !! جمعة مباركة اخواني الكرام اللهم صلي علي سيدنا ((( محمد ))) وعلي آله وصحبه اجمعين جمعة مباركة.rar

اخى الكريم استاذنا ياسر خليل ابو البراء لا اجد من كلمات التعبير ما تكفى عن اعجابى بهذا الموضوع ( موضوع مميز ) وانت طول عمرك صاحب مواصيع جديدة ومميزة ومطلوبة بارك الله فيك اخى الكريم وربنا يزيدك كمان وكمان بارك الله فيك

اخى الفاضل ازاى يعني لا يوجد كود، الكود لا يعمل من خلال زر أمر ... لكن بمجرد فتح الملف سيري ان كان تاريخ اليوم اكبر من التاريخ الذي حددته سيحذف بيانات الشيت .. غير ذلك يبقي الوضع كما هو عليه .... شاهد المرفق وعامة هذا هو الكود انشئ موديول جديد والصق به هذا الكود مع تغيير التاريخ للتاريخ الذي تريده Sub ClearSheet() Dim Ddate As Date Ddate = "28/02/2015" If Date > Ddate Then Sheet1.Cells.ClearContents End If End Sub وفي حدث فتح الملف الصق هذا السطر Private Sub Workbook_Open() ClearSheet End Sub تحياتي Code.rar

ملحق الدرس الرابع الخاص بالرسائل نستعرض هنا الرساله التى تحتوى على مربع ادخال بيان قد يكون اسم ما وقد يكون كلمه سر للدخول فيما يختص بالجزئية الأولى يكون كود الرساله بهذا الشكل وهذا الكود على سبيل المثال Sub example() Dim result As String result = InputBox("Text?", "Title") If result <> "" Then End If End Sub فتكون الرساله بهذا الشكل كما بالصورة التالية وإذا أفترضنا أننا نريد أن يجعل الاكسل يظهر الاسم او الكلمه التى ستكتب داخل هذا المربع فيكون الكود بهذا الشكل Sub example_1 () Dim result As String ("result = InputBox("Text ?", "Title", "write the name If result <> "" Then MsgBox result End If End Sub الاختلاف بين الكودين فى اضافة هذه الجملة Msgbox result وهى تعنى ظهور رساله تاليه بها الجملة التى تم ادخالها بالمربع فتظهر الرساله كما بالصورتيين التاليتين بعد كتابه الاسم على سبيل المثال تظهر الرساله بالشكل التالى نأتى لجزئية كلمة السر لقد جعلت الكود خاص بالمثال العملى المرفق يختص بالدخول الى الشيت الثانى وقد سجلت الكود بمحرر الأكواد الخاص بحدث الشيت الثانى أى داخل الصفحه نفسها من خلال الفيجوال بيسك وان شاء الرحمن سوف نتطرق لأمر الأكواد بشىء من التفصيل فى الدروس القادمة وما هو الفرق بين الكود داخل موديول أو بحدث الشيت أو بحدث المصنف بالكامل والكود الخاص برساله كلمه السر كالتالى Private Sub Worksheet_Activate() xx: Dim x x = InputBox("Password required" & Chr(13) & "يلزم معرفة كلمة السر للدخول لهذه الصفحه ", "فضلاً أدخل كلمة السر") If IsNull(x) Or x = "" Then GoTo xx If x = "بسم الله" Then MsgBox "كلمة السر تم قبولها تفضل لتنفيذ العمليه" Else MsgBox "Wrong Password" & Chr(13) & " عفواً لم تدخل كلمة السر الصحيحه سيتم العوده بك للصفحة الرئيسيه !!", vbOKOnly Sheets("sheet1").Activate End If End Sub فعند محاولة الدخول للشيت الثانى تظهر لنا الرساله كما بالصورة التالية وعند كتابة كلمه السر وهى بسم الله بين الكلمتين مسافة واحده فقط تظهر لنا رساله بهذا الشكل وبالضغط على زر OK يتم الدخول الى الشيت الثانى فى حال كوننا لم ندخل كلمه السر الصحيحة تظهر لنا رساله توضح ذلك وتنتقل مباشرة الى الشيت الأول والرساله كما بالشكل التالى مرفق ملفين الأول ملحق الدرس الرابع PDF الثانى مثال عملى لما ورد بالدرس وتقبلوا منى وافر الاحترام والتقدير ملحق الدرس4.rar مثال عملى ملحق الدرس 4.rar

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

واصل ابداعاتك اخى الكريم . جمعة مباركة

الدرس الرابع الرسائل نتحدث هنا عن استخدام بعض التقنيات التى تجعل استخدامنا للماكرو _ ( برمجه اكسل ) _ أكثر مرونه .. وذات طابع احترافى وأكثر جمالا وذلك من خلال استخدام الرسائل من خلال كتابة بعض الأكواد البسيطه السؤال ؟ أين تكتب تلك الأكواد ؟ تكتب تلك الأكواد داخل حدث الشيت تكتب داخل حدث المصنف تكتب داخل موديول تكتب داخل أكواد اليوزر فورم أى تكتب حسب الحاجه لها على أن تكون داله على الهدف منها سواء كان تحذير من شىء أو طرح سؤال بسيط مثال ( 1 ) نريد أن نتأكد من أن الطابعه فى وضع التشغيل وإعطاء المستخدم فرصة للتأكد من ذلك مع توقف الماكرو عن العمل الى أن يقرر المستخدم الضغط على زر موافق أو OK التالى نص الرساله التى ستظهر كما بالصورة MsgBox “Please make sure that the printer is switched on” جدير بالذكر عند الملاحظة الأولى لشكل الرساله كما بالصورة السابقة نجد نص الرساله ثم زر OK اذا الإستنتاج هنا يدفعنا الى ذكر سؤال هام لمعرفة كيفية ظهورها بهذا الشكل س : مما تتكون الرساله ؟ وكيف تكتب ؟ ج : تتكون الرساله من هذه التركيبة التالية MsgBox (prompt [, buttons] [, title] [, helpfile, context]) السؤال الذى يطرح نفسه هنا س : ماذا تعنى هذه التركيبة ؟ ج : كالتالى كلمة Prompt تعنى ان تكون الرساله سريعه أى عند حدوث أمر ما تظهر الرساله سريعا هناك أيضا أمور يجب ذكرها : 1 - طول الرساله يتكون من 1024 حرف 2 - واذا كانت الرساله تتكون من عده أسطر يجب الفصل بين كل سطر بعلامه (& _ ) 3 – هناك معيار هام فى الرسائل عندما مثلا تريد تحذير المستخدم الى ان الطابعه تعمل مع التأكيد على ذلك بزر OK هنا نستخدم الفواصل وهو امر ضرورى كمثل الرساله التالية MsgBox “Is the printer on?”, , “Caution!” وكما الصورة نأتى الى القيم الرقمية التى سبق الإشارة عنها وبشىء من التفصيل فمثلا إذا كنت تريد القيمة 4 والقيمة 32 يكون النص الذى يكتب فى الكود هكذا MsgBox Prompt:=”Delete this record?”, Buttons:=36 وتظهر الرساله كما بالصورة التالية أو يكتب النص هكذا MsgBox (Prompt:=”Delete this record?”, Buttons:=vbYesNo + vbQuestion) وإذا أردنا كتابة الرسالة بالترتيب الخاص بها كما ذكرنا بكيفية كتابة الرساله فتكون هكذا MsgBox("Text", vbYesNoCancel + vbExclamation + vbDefaultButton2, "Title") فتظهر الرساله كما بالصورة التالية هنا السؤال يطرح نفسه هل يمكن كتابة كل هذه الأزرار فى الرساله ؟ الإجابة بالقطع (( لا )) · فمجموعة القيم من ( 1:5 ) تمثل الأزرار التى ستظهر فى الرساله وعلى حسب ما تريد وتختار · ومجموعة القيم ( 16,32,48,64 ) تمثل نوع الرساله من كونها استفهام أو تعجب .. الخ وعلى حسب ما تختار · ومجموعة القيم ( 0,256,512,768 ) تعنى أى الأزرار YES أو NO أو CANCEL تريدها أن تكون الإفتراضية للمستخدم أى المضيئة يمكن التعبير عن الرساله فى الكود بالقيمة مثل وتظهر الرساله كما بالصورة السابقة MsgBox("Text", 3 + 48 + 256, "Title") مرفق ملف به كامل الدرس الرابع وتقبلوا منى وافر الاحترام والتقدير الدرس 4.rar

السلام عليكم سررة بمرورك العطر جازاك الله خيرا تقبل مني تحياتي

بعد حمد الله وبمساعدة خبراء المنتدى الأستاذ طارق محمود والأستاذ رجب جاويش تم عمل شيت كنترول خاص بالصف الأول الثانوي وهذا العمل جميع عمليات الترحيل والتصفية بطريقة المعادلات لأنني لا اجيد طريقة الاكواد. المدرسة يوجد بها ثلاث فئات من الطلبة طالب منتظم طالب منازل مدرسة (تعدى غيابه 31 يوم وفصل واعيد قيده مرة أخرى) طالب منازل من الخارج وبعد الانتهاء من العمل لاحظت الاتي:- كبر حجم الملف حيث ان حجم الملف يقارب 9 ميجا عدم السرعة في تنفيذ الأوامر في صفحة شيت رصد الدرجات بشكل ملحوظ فارجوا المساعدة من خبراء المنتدى الكرام في التعديل على الملف المرفق لزيادة سرعة تنفيذ الأوامر في شيت رصد الدرجات وتقليل حجم الملف ملحوظة : الحماية الداخلية للملف (0) ولكم منى جزيل الشكر رابط الملف http://www.gulfup.com/?FYDeZC

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

الكود التالي يعيد كافة القيم الإفتراضية لحقول النموذج ، وكأننا ننتقل لسجل جديد ... Private Sub btnClear_Click() Dim ctl As Control On Error Resume Next For Each ctl In Me.Controls ctl.Value = ctl.DefaultValue Next Set ctl = Nothing End Sub والسلام ختام

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

و هذا برنامج جاهز يصنع نظام الصلاحيات تلقائيا للأستاذ المبدع مهند عبادي Users_Maker_2.rar