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

السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الحبيب سبق أن قدمت في موضوع سابق دالة مشابهة لدالة اليوم ، ولكن دالة اليوم مميزة من ناحية سنقوم بسردها بعد قليل رابط الموضوع المتعلق بشبيهة الدالة فاصل ونواصل (أصلي تعبت ... ) دا شكل الدالة المعرفة 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

بسم الرحمن الرحمن الرحيم السلام عليكم ورحمة الله وبركاته حاله من الواقع العملى-- بالاكسيل بافتراض ان لدى جدول ديون العملاء المستحقه وهذه الديون قد تصل الى 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 (مش عشان المشاركة تخصني والله ) ولكن لأنها جمعت الحلول المقدمة بالموضوع كله في ملف مرفق واحد ليستفيد منه الجميع مشكور أخي علي الشيخ على كلماتك الرقيقة ، وبارك الله فيك والشكر موصول دلوقتي وعلطول للفارس المغوار سليم حاصبيا على ما يقدمه من إبداع لا ينقطع والشكر موصول أيضاً للأخ الحبيب علاء رسلان على أن طرح موضوع جمع فيه الأحبة معاً جمعنا الله في الفردوس الأعلى من الجنة تقبلوا تحياتي

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

بارك الله فيك أخي الغالي علي الشيخ بعد إذنك هذه محاولة بدون أعمدة مساعدة جرب المعادلة التالية في الخلية C2 =IF(ISNA(MATCH(A2,$G$3:$G$8,0)),B2,0)

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

السلام عليكم اولا ، اللي اوله شرط ، آخره نور انا ما عندي الاكسس 64 بت ، وما عندي تجربة في الموضوع ، لكني اتذكر ان اختنا الفاضلة الدكتورة أم عهود (حفظها الله اينما كانت) ، كان لها اجابة لهذا الموضوع ، فانا هنا ساعي بريد ، اكتب لكم بالضبط ما كتبته هي في منتدى الفريق العربي للبرمجة ، والشرط هنا ، اني قد لا استطيع مساعدتكم للنهاية ، لأني لا املك اكسس 64 بت والظاهر هنا ، ان الشئ الوحيد الذي يختلف فيه 64 بت عن 32 بت هو في بعض اوامر الكود والوحدات النمطية التي تنادي user32 مثلا ، اي انها 32 بت. والان من هنا ورايح هي مشاركة اختنا الفاضلة زهرة: في حالة وجود اكثر من وحدة نمطية بها Declare فإننا سوف نضع مثل هذا الكود في كل وحده نمطية على حده لتعمل على النظامين 32 بت و 64 بت وطبعا تختلف التصاريح من وحده نمطية والأخرى عن بعضها البعض #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If دالة تحجيم النموذج بعد التعديل Option Compare Database #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If Public Function resizefrom(frm As Form, bestw As Integer, besth As Integer) On Error Resume Next wrate = DisplaySize(0) / bestw hrate = DisplaySize(1) / besth frm.InsideWidth = frm.InsideWidth * wrate frm.InsideHeight = frm.InsideHeight * hrate Dim fc As Control For Each fc In frm.Controls fc.Top = fc.Top * hrate fc.Left = fc.Left * wrate fc.Width = fc.Width * wrate fc.Height = fc.Height * hrate fc.FontSize = fc.FontSize * wrate Next End Function اما الوحدات النمطية التي ليس بها Declare فتبقى كما هي بدون اي تغيير ملاحظة هامة للفهم عند اضافة PtrSafe فإنها تحتاج ايضا الى تعديل بعض المؤشرات Long تتغير الى LongPtr مثال Dim lStructSize As LongPtr دالة ()Len تتغير الى ()LenB حتى يتم قبولها في نظام 64 فقط مثال tsFN.lStructSize = LenB(tsFN) بقية المؤشرات مثل String و Boolean فإنها تبقى كما هي بدون تغيير راجع المصدر https://msdn.microsoft.com/en-us/library/office/gg264421.aspx بالتوفيق

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

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

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

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

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

الاجابة التى كنت اود ان اجدها وجدتها فى اجابة اخى اسلام ابو جومانة باستخدام دالة offset

الأخ الفاضل 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

أخي الفاضل إليك الملف التالي على قدر فهمي .. ويا ريت الأخوة المحاسبين يفيدونا لأنهم أكثر دراية مني بالأمر Sub GrabDataFromSheets() Dim WS As Worksheet, SH As Worksheet Dim Cell As Range Dim X As Long X = 7 Set SH = Sheets("كشف حساب") Application.ScreenUpdating = False SH.Range("B7:E1000").ClearContents For Each WS In ThisWorkbook.Sheets If WS.Name = "المبيعات" Or WS.Name = "المشتريات" Then For Each Cell In WS.Range("C5:C" & WS.Cells(Rows.Count, 3).End(xlUp).Row) If Cell.Value = SH.Range("C3").Value Then SH.Cells(X, 2).Value = Cell.Offset(, -1).Value SH.Cells(X, 3).Value = Cell.Offset(, 1).Value If WS.Name = "المبيعات" Then SH.Cells(X, 4).Value = Cell.Offset(, 4).Value If WS.Name = "المشتريات" Then SH.Cells(X, 5).Value = Cell.Offset(, 4).Value X = X + 1 End If Next Cell End If Next WS Application.ScreenUpdating = True End Sub تقبل تحياتي Grab Data From Two Sheets YasserKhalil.rar

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

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

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

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

خلاص استبدل sum ب count

الأخ الكريم الطاير إذا لم يكن يعجبك الحل بالتنسيق الشرطي (رغم أنه أفضل في هذه الحالة) إليك الحل بالأكواد عله ينال إعجابك 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

إليكم إخوانى فى الله أمثله على الدروس السابقة ملفين اكسل الأول به تطبيق عملى لما ورد بمثال درس الماكرو مع ربطه بدرس الرسائل ونجد به كود هام خاص بالحلقة التكرارية للرسائل والملف الثانى به بعض الأمثله التوضيحيه على كيفية كتابه الكود الخاص بالرسائل وبه مثال هام على كيفية إظهار مدى أهمية الرساله من جعلها تخير المستخدم من تنفيذ الإجراء المطلوب أو التراجع عنه وايضا هذه الجزئية أرفقتها بالمثال الأول ملحوظة هامه سيتم ان شاء الله تعالى اعداد درس ملحق خاص بالرسائل وهو درس صغير ولكنه بنظرى هام فى كيفية استخدامها فى ادخال بيان أو مثلا كلمه سر لأننى لم أتطرق اليها بالدرس الخاص بها وقد سقطت منى سهوا ولم يلفت نظرى أحد من السادة الأعضاء اليها وتقبلوا منى وافر الإحترام والتقدير أمثله.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

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

السلام عليكم جميعا ،، اولا اتمنى ان تقبلوني صديقا جديدا لديكم في هذا المنتدى الرائع ثانيا احببت ان تكون مشاركتي الاولى معكم هو هذا الدرس (دمج المراسلات ) والتي سوف نتابع مع بعض الشرح الخاص به واتمنى ان يكون الشرح واضحا وفي حالة عدم وضوحه اتمنى السؤال وسوف اكون مسرورا وسعيدا للاجابة على اسئلتكم وفق العلم الذي املكه في هذا الجانب رغم انني لازلت اجهل الكثير في عالم الوورد ، وما اضعه بين ايديكم انما هو حصيلة دروس تعلمتها في احد المعاهد واحببت ان يستفيد منها الجميع . ماهو دمج المراسلات ؟؟ تخيل انك سكرتير في شركة مساهمة ، اعضاء هذه الشركة يفوق عددهم الـ 50 الف مساهم ، وقد حان موعد انعقاد الجمعية العمومية لهذه الشركة ، وطبعا لابد من توجيه الدعوات للاعضاء لحضور هذا الاجتماع للشركة ، لذا فأنك ستقوم بتوجيه نفس الدعوة لعدد 50 الف مساهم وسوف تضطر الى كتابة 50 الف اسم مختلف وطباعة كل دعوة على حده وطبعا ذلك سوف يكلفك الوقت والجهد الكثير . بهذه الطريقة نستطيع بـ 6 خطوات فقط ان نكتب ونطبع هذه الدعوات في ظرف دقائق معدودة ربما لا تتجاوز الـ 5 دقائق هل تصدق ذلك ؟؟ نعم صدق وسوف تكتشف ذلك بعد قليل ... لذا دمج المراسلات من ضمن الخصائص الرهيبة والرائعة في برنامج الوورد والتي يجهلها الكثير ، خصوصا اولئك الذين يشتغلون في اعمال السكرتارية وصياغة المخاطبات .. شمّر عن ساعديك فالأمر سهل إن شاء الله وحضر نفسك لقضاء وقت ممتع وتعلم معلومة مفيدة وجديدة لك .. اتمنى من الاعضاء عدم اضافة اي رد حاليا لحين الانتهاء من تنزيل الصور والشرح لهذه الطريقة ... الدرس متاح للجميع وفي حالة نقل المشاركة ارجو الاشارة الى المصدر لان هذا الشرح استغرق مني الوقت الكثير خصوصا في عمل الصور وطبعا في النهاية لا أريد منكم شيئا فقط ان تدعو لي فهذا ما ارجوه منكم .. وارجو الاستفادة للجميع

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