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

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

بارك الله فيك هدية بالطبع مقبولة ,جزاك الله خير الثواب

تفضل اخي هذا بالكود افضل من المعادلات لعله المطلوب Sub FindName() Dim v As String, rngFound As Range v = Application.InputBox(Prompt:="Enter Name or Number Code", Type:=2) If v = "False" Then Exit Sub 'user canceled Set rngFound = Range("A:B").Find(v, , xlValues, xlWhole, 1, 1, 0) If Not rngFound Is Nothing Then Range("C2").Value = rngFound.EntireRow.Range("B1").Value Range("D2").Value = rngFound.EntireRow.Range("A1").Value Else Range("C2:D2").ClearContents MsgBox v, vbExclamation, "No Match Found" End If End Sub مطلوب.xls

السلام عليكم هل هذا ماطلبت اعلمنا رجاءا Database2.rar

وعليكم السلام .. كان عليك استخدام خاصية البحث بالمنتدى فقد تم تناول هذا الموضوع مرات عديدة جداً , ويتلخص الموضوع فى ضبط اللغة العربية على الكمبيوتر كما بهذا الرابط : تعديل وضبط كود التفقيط

اتفضلوا البرنامج العملاء_والديون_اقساط_0777134668.accdb

تفضل اخي اتمنى ان يكون المطلوب test.xlsx

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

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

قم باستبدال 2 و 3 في هذين السطرين من الكود (اكتب 2 ماكن الــ 3 و 3 مكان الــ 2) sec.Cells(m, k) = S.Cells(i, 3) sec.Cells(m, k + 1) = S.Cells(i, 2)

هدية رائعة وقيمة سلمت يداك ننتظر منك المزيد من هذه المفاجئا ت الجميلة

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

وعليكم السلام-لك ما طلبت على الرغم ان هذا الموضوع تكرر مئات المرات فى المنتدى فعليك بعد ذلك استخدام خاصية البحث بالمنتدى قبل رفع المشاركة فالمنتدى به كنــــوز id emplloy1.xlsx

أتمنى أن يكون هذا ما فهته من حضرتك مطلوب 2.xlsx

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

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الكود التالي Private Sub Form_Current() If IsNull(fullname) Or IsNull(id) Or IsNull(job) Then Me.عنصر_تحكم_علامة_جدولة7.Enabled = False Else Me.عنصر_تحكم_علامة_جدولة7.Enabled = True End If End Sub ddd.rar تحياتي

جزاك الله خيرا اخى @عبد اللطيف سلوم

احسنت يا ابا اشرف

بارك الله فيك وزادك الله من فضله ورحم الله والديك

وعليكم السلام-يمكنك تطويع هذا الكود Option Explicit Option Base 1 Sub Wsh_CopyTo_NewWbk() Dim aWsh As Variant aWsh = [{"Sheet1","Wsh1";"Sheet2","Wsh2"}] Dim aWshSrc(2) As Worksheet Dim wbk As Workbook, wsh As Worksheet Dim vItm As Variant, b As Byte Rem Set Worksheet Array With ThisWorkbook For b = 1 To UBound(aWsh) .Worksheets(aWsh(b, 1)).Unprotect Password:=aWsh(b, 2) Set aWshSrc(b) = .Worksheets(aWsh(b, 1)) Next: End With Rem Add New Workbook Set wbk = Workbooks.Add With wbk Rem Delete All Worksheets but One Application.DisplayAlerts = False For Each wsh In .Worksheets With wsh If .Index = 1 Then .Name = "!DELETE" Else .Delete End With: Next Application.DisplayAlerts = True Rem Copy Worksheets For Each vItm In aWshSrc vItm.Copy After:=Sheets(.Sheets.Count) Set wsh = .Sheets(.Sheets.Count) wsh.UsedRange.Value = wsh.UsedRange.Value2 Next Rem Delete Reamining Worksheet Application.DisplayAlerts = False .Worksheets("!DELETE").Delete Application.DisplayAlerts = True End With End Sub

أحسنت استاذ خلف جزاك الله كل خير

بارك الله فيك وزادك الله من فضله

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

تفضل تم وضع كود الأستاذ ابراهيم بملفك وربطه بالزر 111.xlsm

وعليكم السلام-لك ما طلبت 1مرتب.xlsx

وعليكم السلام-تفضل لك ما طلبت طرح تاريخ.xlsm

السلام عليكم انظر للمرفق الاسم : kh كلمة المرور: 12345 q.rar

تم معالجة الامر الكود Option Explicit Sub resume_facture() Dim my_arr2(1 To 2) my_arr2(1) = "مجموع مبلغ الشراء حسب التاريخ": my_arr2(2) = "التاريخ": Dim i%, k%, m%: m = 2 Dim s# Dim lr1%: lr1 = Achat.Cells(Rows.Count, 1).End(3).Row Dim lr2%: lr2 = Detail.Cells(Rows.Count, 1).End(3).Row Dim lr3%: lr3 = By_Date.Cells(Rows.Count, 1).End(3).Row Dim laste_e% Dim laste_B% Detail.Range("A1:e" & lr2).ClearContents By_Date.Range("a1:b" & lr3).ClearContents Dim Fter_Rg As Range Set Fter_Rg = Achat.Range("a1:e" & lr1) Dim Col As Object Set Col = CreateObject("system.collections.arraylist") With Col For i = 2 To lr1 If Not .contains(Achat.Range("b" & i).Value) Then _ .Add Achat.Range("b" & i).Value Next End With For i = 0 To Col.Count - 1 '----------------------------- laste_e = Detail.Cells(Rows.Count, 1).End(3).Row If laste_e% <> 1 Then laste_e% = laste_e% + 2 '========================= Fter_Rg.AutoFilter 2, Col.Item(i) Fter_Rg.SpecialCells(12).Copy _ Detail.Range("a" & laste_e%) Next Fter_Rg.AutoFilter Col.Clear '========================= By_Date.Cells(1, 1).Resize(, 2) = my_arr2 For i = 2 To lr1 If Not Col.contains(Achat.Range("d" & i).Value) Then _ Col.Add Achat.Range("d" & i).Value Next '========================= For i = 0 To Col.Count - 1 By_Date.Range("b" & i + 2) = Col.Item(i) For k = 2 To Fter_Rg.Rows.Count If Achat.Range("D" & k) = Col.Item(i) Then s = s + Achat.Range("C" & k) End If Next By_Date.Range("A" & i + 2) = s s = 0 Next Creat_formula '=================== End Sub Rem+++++++++++++++++++++++++++++++++++++++++++++++++ Sub Creat_formula() With Detail Dim arr1(), arr2(), k%: k = 1 Dim t%: t = 1 Dim i% Dim Ro%: Ro = .Cells(Rows.Count, 2).End(3).Row For i = 2 To Ro + 1 If .Cells(i, 2) = "" Then .Cells(i, 1) = "Sum" End If Next .Range("F2:F" & Ro).Formula = "=IF(NOT(ISNUMBER(C2)),"""",SUM(C2,-E2))" '========================== For i = 1 To Ro + 1 If .Cells(i, 1) = "رقم بطاقة السكن" Then ReDim Preserve arr1(1 To k): arr1(k) = (.Cells(i, 1).Row) + 1 k = k + 1 End If Next For i = 1 To Ro + 1 If .Cells(i, 1) = "Sum" Then ReDim Preserve arr2(1 To t): arr2(t) = (.Cells(i, 1).Row) - 1 t = t + 1 End If Next '========================= For i = LBound(arr1) To UBound(arr1) With .Cells(arr2(i) + 1, 3) .Formula = "=SUM(C" & arr1(i) & ":C" & arr2(i) & ")" .Offset(, 2).Formula = "=SUM(E" & arr1(i) & ":E" & arr2(i) & ")" .Offset(, 3).Formula = "=SUM(F" & arr1(i) & ":F" & arr2(i) & ")" End With Next Erase arr1: Erase arr2 End With End Sub _Version _1 _salim.xlsm

جرب هذا الماكرو Option Explicit Sub resume_facture() Dim my_arr2(1 To 2) my_arr2(1) = "مجموع مبلغ الشراء حسب التاريخ": my_arr2(2) = "التاريخ": Dim i%, k%, m%: m = 2 Dim s# Dim lr1%: lr1 = Achat.Cells(Rows.Count, 1).End(3).Row Dim lr2%: lr2 = Detail.Cells(Rows.Count, 1).End(3).Row Dim lr3%: lr3 = By_Date.Cells(Rows.Count, 1).End(3).Row Dim laste_D% Dim laste_B% Detail.Range("A1:D" & lr2).ClearContents By_Date.Range("a1:b" & lr3).ClearContents Dim Fter_Rg As Range Set Fter_Rg = Achat.Range("a1:d" & lr1) Dim Col As Object Set Col = CreateObject("system.collections.arraylist") With Col For i = 2 To lr1 If Not .contains(Achat.Range("b" & i).Value) Then _ .Add Achat.Range("b" & i).Value Next End With For i = 0 To Col.Count - 1 '----------------------------- laste_D = Detail.Cells(Rows.Count, 1).End(3).Row If laste_D% <> 1 Then laste_D% = laste_D% + 2 '========================= Fter_Rg.AutoFilter 2, Col.Item(i) Fter_Rg.SpecialCells(12).Copy _ Detail.Range("a" & laste_D%) Next Fter_Rg.AutoFilter Col.Clear '========================= By_Date.Cells(1, 1).Resize(, 2) = my_arr2 For i = 2 To lr1 If Not Col.contains(Achat.Range("d" & i).Value) Then _ Col.Add Achat.Range("d" & i).Value Next '========================= For i = 0 To Col.Count - 1 For k = 2 To Fter_Rg.Rows.Count If Achat.Range("D" & k) = Col.Item(i) Then By_Date.Range("b" & i + 2) = Col.Item(i) s = s + Achat.Range("C" & k) End If Next By_Date.Range("A" & i + 2) = s s = 0 Next '=================== End Sub الملف مرفق _salimجدول الشراء.xlsm

السلام عليكم أساتذتى واخوانى الكرام أقدم لكم برنامج شئون العاملين فى التربية والتعليم البرنامج من إعداد الأستاذ / أحمد عريضه البرنامج مجاني ومتاح لجميع المدارس العمل عليه . يستخرج صحيفة احوال لكل معلم . صفحة الطباعة ( صحيفة الاحوال ) منسقة ومعدلة علي الطباعة . لا يوجد علامات مائية . لا يوجد اسماء بصحيفة الاحوال خارجية . البرنامج يستخرج تاريخ الميلاد من الرقم القومي . البرنامج يستخرج نوع المعلم أو المعلمة من الرقم القومي . يوجد صفحة ادخال بيانات من خلالها يمكن ادخال بيانات لجميع العاملين . البرنامج يحمل أكثر من 1200 اسم . البرنامج يعمل علي اكسل ويفضل اكسل 2010 فيما أعلي . يمكن اضافة شعار للمؤسسة أو المدرسة . يمكن كتابة اسم المديرية والإدارة والمدرسة والتوجيه باللغتين العربية والإنجليزية . الصحيفة تحمل بيانات أكثر من صحيفة الأحوال الواردة من الوزارة . يمكن التعديل علي أي بيانات من صفحة التعديل وتظهر فوراً في صفحة الطباعة . وهذا فيديو لشرح البرنامج والعمل عليه https://www.youtube.com/watch?v=ThdIU4KQh7Q وهذا هو البرنامج برنامج شئون العاملين بالتربية والتعليم مجانا 2019 excel تحميل برنامج شئون العاملين مفتوح المصدر.xlsx

السلام عليكم ورحمة الله إليك بالملف التالي الذي يحوي 5 صفحات وزعتها على 5 مقاطع (كل صفحة بمقطع) وكل صفحة لها إطارها الخاص بها... Ex_Bord.doc Ex_Bord.rar