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

بسم الله الرحمن الرحيم هذا ملف به كود لتوزيع طلاب المدارس على الفصول .. اكثر من رائع لسهولته وسرعته لانه يعمل بالمصفوفات صاحب هذا الكود هو المبدع ياسر خليل .. جزاه الله عنا كل خير وبارك في كل واحد يخلص في عمله من اجل رحمة الله تعالى تكوين فصول للمحترم ياســـــــــــــــــــر خليل.rar Option Explicit Sub ClassesListsUsingArrays() 'Author : YasserKhalil 'Release : 30 - 06 - 2017 '------------------------ Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim temp As Variant Dim i As Long Dim j As Long Dim p As Long Dim n As Long Dim str As String 'لمنع اهتزاز الشاشه Application.ScreenUpdating = False 'متغير اسم ورقه المصدر Set ws = Sheets("بيانات الطلبة") 'متغير اسم ورقه الهدف Set sh = Sheets("فصول") 'مسح بيانات قائمه الفصل sh.Range("B8:F43,H8:L43").ClearContents 'مدى صفوف قائمه الفصل وان تكون عدم مخفيه sh.Rows("8:43").Hidden = False 'خليه القائمه المنسدله لاسماء الفصول str = sh.Range("L1").Value 'مدى صفحة المصدر arr = ws.Range("A7:W" & ws.Range("A" & Rows.Count).End(xlUp).Row).Value ' يقوم بتعيين أبعاد المصفوفة (مصفوفة النتائج) 'لتكون بنفس أبعاد مصفوفة البيانات من حيث عدد الصفوف وعدد الأعمدة ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) 'مطابقة القيمة الموجودة في العمود رقم 22 (الذي يحتوي على رقم الفصل) 'مع الشرط في الخلية L1 For i = 1 To UBound(arr, 1) 'متغير رقم عمود الفصل If arr(i, 22) = str Then 'يزيد المتغير P بمقدار واحد p = p + 1 For j = 1 To UBound(arr, 2) temp(p, j) = arr(i, j) Next j 'هذا السطر الذي يتعامل مع القيمة كتاريخ temp(p, 7) = CLng(arr(i, 7)) 'تم وضع رقم تسلسلي للنتائج حسب قيمة المتغير temp(p, j - 1) = p End If Next i 'عند حدوث خطأ انتقل الى الخطوه التاليه On Error Resume Next n = WorksheetFunction.Round(p / 2, 0) 'الرقم 23 الخاص بالمسلسل 'رقم عمود موجود بالمصفوفه 'ولايوجد به بيانات sh.Range("B8").Resize(n, 5).Value = Application.Index(temp, Evaluate("row(1:" & n & ")"), Array(23, 5, 15, 7, 16)) 'الاسم / الديانه/ تاريخ الميلاد / القيد sh.Range("H8").Resize(n, 5).Value = Application.Index(temp, Evaluate("row(" & n + 1 & ":" & p + 1 & ")"), Array(23, 5, 15, 7, 16)) For i = 43 To 8 Step -1 If sh.Cells(i, 2).Value = "" Then sh.Rows(i & ":43").Hidden = True Next i ' اعاده الشاشه كما كانت Application.ScreenUpdating = True End Sub هذا هو تحفة الاكواد للنابغه ياسر خليل

وعليكم السلام جرب الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$13" Then If Target.Value = 0 Then ActiveSheet.Buttons("Button 1").Visible = False ElseIf Target.Value > 0 And IsNumeric(Target) Then ActiveSheet.Buttons("Button 1").Visible = True Else MsgBox "Enter Numeric Value", vbExclamation End If End If End Sub

جزاك الله كل خير ايها الاستاذ المحترم يا سر خليل وبعد : اخي السائل الكريم الكود من اسهل الاكواد وينفع لاي مرحله تريدها وينفع تغير ماتشاء من اسماء الاعمدة اما بالنسبه لطلبك , Array(23, 5, 15, 7, 16)) ابحث عن هذا الجزء ستجده مرتين غير الرقم 7 بالرقم 6 وشكرا مامعنى ذلك ؟ اننا يحثنا في صفحة بيانات المصدر عن رقم العمود المطلوب ادراجه في القائمه ووضعناه في مكانه في الكود

السلام عليكم وضعت بالمرفق نموذجين بفكرتين احداهما بزيادة نصف ساعة للوقت - والأخرى باظهار التناقص الزمنى أمام المدخل أرجو أن تنال اعجابك أحدهما - وإن لم يعجباك فادعو لنا بخير تفضل المرفق DB1.rar

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

السلام عليكم اليكم ملف اكسيل يحسب ضريبة كسب العمل حسب التعديلات الأخيرة قانون رقم ( 82 ) لسنة 2017 وهنا الخصم محسوب على اجمالى الضريبة المستحقة وليس مبلغ الشريحة وهذا التفسير الاقرب للصحة حسب راى فقهاء واساتذة الضرائب فى مصر . ((ومع ذلك ستكون اللائحة التنفيذية هى القول النهائى )) ومحتويات هذا الملف : -الملف يشمل نص القانون -ويشمل مثال توضيحي وكيف يتم حساب الشرائح ومبلغ كل شريحة -ويشمل معادلة واحدة تحسب الضريبة بما فيها الشرائح والخصم لمره واحده حسب شريحة الممول ملحوظة هاااامه : (تم حساب الوعاء الخاضع للضريبة بعد خصم الاعفاء الشخصى 7000 فهو لم يعدل ). الملف بدون حماية ويحق للجميع النقل والاستفاده منه كما يشاء . وفق الله الجميع زكاة العلم نشره وارجو مشاركة الجميع تحميل الملف :https://www.mediafire.com/?la1rv8tr5t1ho0x لا تنسونا بصالح دعاؤكم هذا وماكان من توفيق فمن الله وحده وماكان من خطا او نسيان اوزلة لسان فمنى ومن الشيطان خالص تحياتى لكم التحميل فى المرفقات TAX 2017 - 2.rar

أخي الكريم الكود بالفعل يقوم بكسر حماية السر لأوراق العمل .. وتوجد طرق كثيرة لكسر الحماية وما أيسرها ..!! لذا بدلاً من حذف تلك الطرق يفضل البحث عن طرق أكثر أماناً كتحويل الملف لملف تنفيذي .. وهذا أمر قد تم مناقشته من قبل في موضوعات كثيرة ويمكنك استخدام خاصية البحث للوصول لتلك الموضوعات

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

تفضل بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-1900#,[Forms]![main]![Datamasterform]![DateX])) And (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-2900#,[Forms]![main]![Datamasterform]![DateX]+65)) والشرح Between (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-1900#,[Forms]![main]![Datamasterform]![DateX])) And (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-2900#,[Forms]![main]![Datamasterform]![DateX]+65)) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-1900#,[Forms]![main]![Datamasterform]![DateX])) And (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-2900#,[Forms]![main]![Datamasterform]![DateX]+65)) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-1900#,[Forms]![main]![Datamasterform]![DateX])) And (IIf(Len([Forms]![main]![Datamasterform]![DateX] & "")=0,#01-Jan-2900#,[Forms]![main]![Datamasterform]![DateX]+65)) Or [DateX] Is Null جعفر

Sub Sort_Male() Dim lr As Long lr = Range("E" & Rows.Count).End(xlUp).Row Range("E7:Q" & lr).Sort Key1:=Range("F7:F" & lr), _ Order1:=2, Header:=xlNo End Sub ضع هذا الكود في موديول واعمل له .. زر بصفحه بيانات المصدر لاتقلق هذا فرز ليأتي بالذكور اولا واذا اردت ان تجعله يأتي بالبنات اولا فما عليك الا ان تغير الرقم 2 الموجود في الكود وتجعله الرقم 1

انسخ هذه المعادلة الى الخلية C2 في ورقة Main استعملها مع Ctrl+Shift+Enter ثم اسحبها نزولاً =INDEX('قائمة حساب الفواتير'!$D$2:$D$500,MAX(IF($B2='قائمة حساب الفواتير'!$B$2:$B$500,ROW($B$2:$B$500)-1,0)))

خطوط ولا اروع هديه طيبه ان شاء الله ستجعل صوره القائمه غايه في الروعه خط.rar ========== رابط لخطوط غايه في الجمال والروعه https://up.top4top.net/downloadf-3206k2ma1-rar.html

أخي محمد الربكة عندك في And و Or ، فرجاء مراجعة عملهم بالضبط. رجاء عمل التالي: 1. وانت في النموذج ، اضغط على زرّي لوحة المفاتيح: Ctrl + G 2. وسيأخذك الى صفحة الكود ، وستلاحظ نافذة صغيرة في اسفل صفحة الكود ، 3. السطر التالي ، احذف اول اشارة من سطره ، الاشارة: ' 'Debug.Print myCriteria' 4. اذهب للنموذج واعمل التصفية التي تريدها 5. ارجع لصفحة الكود ، وستلاحظ في النافذة الصغيرة وجود كود التصفية 6. انسخ هذا الكود 7. اعمل استعلام فارغ 8. بالزر اليمين في الاستعلام ، غيّر الاستعلام من تصميم الى SQL 9. احذف الكلمات الموجودة في الاستعلام ، والصق كود النموذج 10. شغّل الاستعلام ، وشوف نتائجه 11. ضع الاستعلام في وضع تصميم ، وشوف تفاصيله ، وهي التفاصيل التي قمت بها انت لتصفية النموذج. 12. العب في And و Or للحقول التي تريدها ، وسوف تعرف ايهم تستعمل والانسب لعملك ، وعليه ترجع لكود تصفية النموذج وتغيّر فيه حسب طلبك ************************* هذا الموضوع هو انشاء تصفية ولعدة حقول ، والحمدلله استطعت انت ان تجرب النتائج جعفر

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

الف الف الف مليون شكر هو المطلوب

السلام عليكم تفضل جرب المرفق دور ثانى1.rar

تم التعديل على الملف يحيث لا يقبل تكرار الكود My_codes_salim.rar

استاذى الغالى والحبيب والكبير ابوالبراء دائما تسعدنى بمرورك وتشجيعك الدائم جزاكم الله خيرا

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

وعليكم السلام تفضل Book11.rar

حيث ان اللائحة عندك طويلة جداَ و لا يوجد وقت لاكمال هكذا اعمال ربما تجد المساعدة في هذا الملف يمكنك تعديل الكود حسب ما تريد ليتناسب مع الملف عندك يرجى في المرات القادمة اختصار الملف الى (10- 15)صف مع عدم الزركشة (ألوان و تنسيقات تبهر الناظر اليها وتمنعه من التركيز على البيانات) My_codes.rar

وعليكم السلام المفروض ان الاكسس يعطيك كود مثل هذا: ([testQ].[datex] between #01-Jul-17# and #27-Apr-17#) AND ([testQ].[country1]= 'اسكندرية' or [testQ].[country1]= 'الدقهلية' or [testQ].[country1] is null) اليك الكود ، وقد فككته الى اصغر مكوناته وانت اعمل المدرسة Dim City As String City = "اسكندرية" City2 = "الدقهلية" 'مجموعة اوامر الحقل الاول 'للتاريخ myCriteria = "(" myCriteria = myCriteria & "[testQ].[datex] between #" & Me.DateX & "# and #" & Me.DateX - 65 & "#" myCriteria = myCriteria & ")" 'مجموعة اوامر الحقل الثاني myCriteria = myCriteria & " AND " myCriteria = myCriteria & "(" 'للنص myCriteria = myCriteria & "[testQ].[country1]= '" & City & "'" myCriteria = myCriteria & " or " myCriteria = myCriteria & "[testQ].[country1]= '" & City2 & "'" myCriteria = myCriteria & " or " myCriteria = myCriteria & "[testQ].[country1] is null" myCriteria = myCriteria & ")" 'للرقم 'myCriteria = myCriteria & " AND " 'myCriteria = myCriteria & "[testQ].[ID]<> " & Me.ID 'Debug.Print myCriteria Me.TestF.Form.Filter = myCriteria Me.TestF.Form.FilterOn = True جعفر

وعليكم السلام واهلا وسهلا بك في المنتدى هذا له علاقة باعدادات الوندوز ، حيث انك لم تقم بإختيار دولة عربية لحروف Unicode ، رجاء التاكد اختيار لغة الدولة في رقم 4 من الرابط المرفق جعفر

السلام عليكم ورحمة الله وبركاته أعلم ان هذا يشغل بال الاخوة بسبب طبيعة الطلب تفضل أخي العزيز بعد التعديل المطلوب DB.rar

اتفضل اليك هذا Dim sql As String 'sql = "UPDATE [C:\Users\MyShiv\Desktop\تحيث جدول في قاعدة خارجية\db1.mdb].Table1 INNER JOIN [C:\Users\MyShiv\Desktop\تحيث جدول في قاعدة خارجية\db2.mdb].Table2 ON Table1.ID = Table2.ID SET Table2.nAME = [Forms]![Form1]![nAME], Table2.no_phone = [Forms]![Form1]![no_phone] WHERE (((Table2.ID)=[Forms]![Form1]![ID]));" 'sql = "UPDATE Table1 INNER JOIN [C:\Users\MyShiv\Desktop\تحيث جدول في قاعدة خارجية\db2.mdb].Table2 ON Table1.ID = Table2.ID SET Table2.nAME = [Forms]![Form1]![nAME], Table2.no_phone = [Forms]![Form1]![no_phone] WHERE (((Table2.ID)=[Forms]![Form1]![ID]));" sql = "UPDATE Table1 INNER JOIN [db2].Table2 ON Table1.ID = Table2.ID SET Table2.nAME = [Forms]![Form1]![nAME], Table2.no_phone = [Forms]![Form1]![no_phone] WHERE (((Table2.ID)=[Forms]![Form1]![ID]));" DoCmd.SetWarnings False DoCmd.RunSQL (sql) DoCmd.SetWarnings True MsgBox "تم تحديث" واليك قاعدة بيانات بعد تعديل اولا اختر قاعدة بيانات باسم db2 بعدين اضغطعلى زر للتحديث تحيث جدول في قاعدة خارجية - Copy.rar

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

اعمل استعلام الحاقی لكن في المرفق المعلومات الرواتب لاشخاص الثلاثة ليس موجودة لذا يجب ان تأخذ البيانات الثلاثة من جدول المعلومات الرواتب بعدين تعمل استعلام الحاقي عيد سعيد

السلام عليكم استبدل الكود السابق بهذا الكود Option Explicit Sub Button1_Click() Dim ws As Worksheet, wb As Workbook Dim NextRow As Long, LastRow As Long On Error Resume Next Set wb = Workbooks("الصادر.xlsx") Set ws = ThisWorkbook.Sheets("قاعدة البيانات") NextRow = ws.ListObjects("Table2").Range.Columns(3).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row If wb Is Nothing Then Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "الصادر.xlsx") Else wb.Activate End If With wb.Sheets("الصادر العام") LastRow = .ListObjects("الجدول1").Range.Columns(3).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 .Range("C" & LastRow).Value = Format(Date, "yyyy/mm/dd") .Range("D" & LastRow).Value = "طلاب" .Range("E" & LastRow).Value = ws.Range("E" & NextRow).Value .Range("C" & LastRow).Select End With End Sub khaled.rar

شكرا اختي وجزاك الله كل خير شكرا لك اخي الحبيب الحلبي شكرا لك استاذي الحبيب نتعلم منكم

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

وعليكم السلام نعم ممكن هل تريد فتح الموقع عبر متصفح ميكروسوفت ام عبر متصفح قوقل ؟