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

اتفضل اخي الفاضل هذه طريقة اخرى بدون اكواد Rac.rar

برنامج حسابات شركات المقاولات المتكامل The Fastest 2023 مع الكراك رابط تحميل البرنامج https://www.mediafire.com/file/fyr7mwpun0hevps/The+Fastest+2023.rar/file روابط شرح البرنامج على يوتيوب YouTube 1- المقدمة ودليل الحسابات https://www.youtube.com/watch?v=JgvfkAPZIwo&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=1&t=221s 2- الأصول الثابتة https://www.youtube.com/watch?v=6GDuQOPJ1xo&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=2 3- المقابسات والمستخلصات https://www.youtube.com/watch?v=nSjE5wO6Q8E&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=3 4- عقود ومستخلصات مقاولين الباطن وسراك المعدات والعمالة https://www.youtube.com/watch?v=k7sC_WoUWSo&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=4 5- المشتريات والمخازن https://www.youtube.com/watch?v=qBJl2ATd428&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=5 6- المشتريات المستوردة وتكلفة الرسائل https://www.youtube.com/watch?v=JjI3OXvZTeg&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=6 7- البنوك والشيكات وأوراق القبض https://www.youtube.com/watch?v=BFpfrU6G0Jw&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=7 8- شئون العاملين والأجور والمرتبات https://www.youtube.com/watch?v=gKPJP0oNW7w&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=8 9- أدوات البرنامج والوظائف المتعددة لإدارة النظام https://www.youtube.com/watch?v=T9xhsBO5mNI&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=9 10 – ربط البرنامج على شبكة داخلية وعلى الانترنت https://www.youtube.com/watch?vyto1eP0oNW7w&list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ&index=8 ضع ردا للإظهار باقي ابط

وعليكم السلام ورحمه الله وبركاته اتفضل new.accdb

السلام عليكم بناءا على طلب احد الاخوة المتابعين تطبيق عملي لطريقة عمل فلتر بحث في كافة الاسماء بطريقة احترافية الشرح على قناتي على اليوتيوب search.accdb

الشكر لله ثم لاخواننا واساتذتنا وبما ان طريقتى عجبتك اتفضل التعديلات التى قد اشرت اليها بالتوفيق Rac_1.accdb

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

السلام عليكم ورحمة الله وبركاته السادة الزملاء الأعزاء إخوانى فى الله بفضل الله ومساعدة الأستاذ القدير أستاذى ومعلمى وأخى فى الله / @ياسر خليل أبو البراء تم الوصول إلى معادلة ممتاذة وقامت بالمطلوب بالفعل وهى : IFERROR(IF(E2=0;"";IF(G2<50%;F2*0;IF(AND(G2>=50%;G2<60%);(G2*F2)*1%;IF(AND(G2>=60%;G2<65%);F2*0.65%;IF(AND(G2>=65%;G2<70%);=(G2*F2)*1%;IF(AND(G2>=70%;G2<75%);F2*0.75%;IF(AND(G2>=75%;G2<80%);(G2*F2)*1%;IF(AND(G2>=80%;G2<90%);F2*0.9%;IF(AND(G2>=90%;G2<100%);(G2*F2)*1%;IF(G2>=100%;F2*1.2%))))))))));"") وتم تطبيقها بالنموذج المرفق وأحببت أن أشاركها معكم ليستفاد الجميع بارك الله فيك أخى الحبيب @ياسر خليل أبو البراء وزادك من علمه وفضله وجعله فى ميزان حسناتك تجربة.xlsx

تفضل هذا مثال للمطلوب محافظات.zip Jordan2024.accdb

اتفضل اخي الكريم تم تعديل الملف السابق كما تريد فضلا ان كان هذا ما تريد اضغط على افضل اجابة 👍 بحث عن درجات.rar

برنامج المستودعات ضع مجلة stock في c stock.rar

السلام عليكم ورحمة الله وبركاته استخدم المعادلة التالية =IF(G2>1,(F2*0.012),IF(G2>0.9,((G2*F2)*0.01),IF(G2>0.8,(F2*0.009),IF(G2>0.75,((G2*F2)*0.01),IF(G2>0.7,(F2*0.0075),IF(G2>0.65,((G2*F2)*0.01),IF(G2>0.6,(F2*0.0065),IF(G2>0.5,((G2*F2)*0.01),0)))))))) ملاحظة : هناك خطأ في تكوين قاعدة الاحتساب بين الشريحتين التاليتين: بداية من 80% حتى 84.99 % يستحق 90% من ال 1% بداية من 90% حتى 99.99% يستحق نفس النسبة المحققة من ال 1% والصحيح أن تكون نهاية الشريحة هو بداية الشريحة التالية ، وهو ما قمت بتعديله في المعادلة إجتهادا مني (حتى 89.99%) نصيحة .. حاول تستخدم قاعدة أبسط لاحتساب العمولات للتيسير عليك وعلى العاملين معك. معادلة حساب عمولة بشروط نسب المحققات (1).xlsx

حسناً يجب أخذ في عين الإعتبار وجود نفس القيمة مكررة في أكثر من خلية مع أني لا أعتقد ذلك بحسب المعادلة التي وضعها السيد مشعل لكن بكل الأحوال ممكن تجربة هذا الكود Sub test() Dim i& Dim x As String Dim r As Range Application.ScreenUpdating = False Range("A1:AI35").Interior.Color = xlNone For i = 14 To 15 With Range("A1:AI35") Set r = .Cells.Find(Range("AL" & i), , , 1) x = r.Address Do r.Interior.Color = vbRed Set r = .Cells.FindNext(r) Loop Until r.Address = x End With Next Application.ScreenUpdating = True End Sub 'وأيضاً لتلوين كل رقم بلون مختلف Sub test2() Dim i& Dim x As String Dim r As Range Dim f As Boolean Application.ScreenUpdating = False Range("A1:AI35").Interior.Color = xlNone For i = 14 To 15 With Range("A1:AI35") Set r = .Cells.Find(Range("AL" & i), , , 1) x = r.Address Do r.Interior.Color = IIf(f, vbRed, vbYellow) Set r = .Cells.FindNext(r) Loop Until r.Address = x End With f = True Next Application.ScreenUpdating = True End Sub

Option Explicit Public Property Get WSData() As Worksheet: Set WSData = Sheets("ورقة1") End Property Public Property Get WSDest() As Worksheet: Set WSDest = Sheets("ورقة2") End Property '***' اظافة مربعات الاختيار عند التحقق من وجود قيمة في عمود الاسم Sub Add_CheckBoxes() Dim cell, col As Single, Cpt As CheckBox Dim MyLeft, MyTop, MyHeight, MyWidth As Double Application.ScreenUpdating = False col = WSData.Range("B" & Rows.Count).End(xlUp).Row WSData.CheckBoxes.Delete For cell = 2 To col If WSData.Cells(cell, "B").Value <> "" Then MyLeft = Cells(cell, "A").Left: MyTop = Cells(cell, "A").Top MyHeight = Cells(cell, "A").Height: MyWidth = Cells(cell, "A").Width WSData.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select With Selection .Caption = "": .Value = xlOff: .Display3DShading = False End With [A1].Select End If Next cell Application.ScreenUpdating = True End Sub '**** نسخ الاعمدة المحددة Sub CopyRows() Dim derlig&, r&, Lr&, Cpt As CheckBox For Each Cpt In WSData.CheckBoxes If Cpt.Value = 1 Then For r = 1 To Rows.Count If Cells(r, 1).Top = Cpt.Top Then With WSDest .Range("A2:A" & Rows.Count).ClearContents Lr = .Range("B" & Rows.Count).End(xlUp).Row + 1 ' عمود الاسم .Range("B" & Lr) = _ WSData.Range("B" & r).Value 'في حالة الرغبة بنسخ عدة اعمدة قم بظبط السطر التالي بما يناسبك ' .Range("B" & Lr & ":F" & Lr) = _ ' WSData.Range("B" & r & ":F" & r).Value '**** تسلسل البيانات المنسوخة derlig = WSDest.Range("B" & WSDest.Rows.Count).End(xlUp).Row WSDest.Range("A2").Value = 1 WSDest.Range("A2:A" & derlig).DataSeries , xlDataSeriesLinear End With Exit For End If Next r End If Next On Error Resume Next WSData.CheckBoxes.Value = False On Error GoTo 0 End Sub Microsoft Excel Worksheet جديد (2).xlsm

مبدع ...استاذي @ابوبسمله

وعليكم السلام ورحمة الله تعالى وبركاته تفضل جرب اخي Sub FindCouleur() Dim j(1 To 2) As String, F As Variant Dim a As Range, R As Range, T&, Cpt&, lCol&, lrow& Dim WS As Worksheet: Set WS = Worksheets("0") Application.ScreenUpdating = False lrow = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column j(1) = [Al14]: j(2) = [Al15] Set a = WS. _ Range("A1", WS.Cells(lrow, lCol)) F = Array(j(1), j(2)) With a .Interior.ColorIndex = xlNone For Cpt = LBound(F) To UBound(F) Set R = .Cells(.Cells.Count) For T = 1 To WorksheetFunction.CountIf(a, F(Cpt)) Set R = .Cells.Find(What:=F(Cpt), LookIn:=xlValues, LookAt:=xlWhole, _ After:=R, MatchCase:=False) R.Interior.Color = vbYellow Next T Next End With Application.ScreenUpdating = True End Sub أرقام.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته ربما هدا ما تقصد https://streamable.com/lrih4i في الخلية B5 =A2 في الخلية B6 مع السحب للاسفل للحصول على التواريخ =IF(ROW(B1)>=$B$2;"";EDATE($B$5;ROW(B1)*12)) وفي الخلية A5 مع السحب للاسفل للحصول على التسلسل =IF(B5<>"";ROWS($B$1:B1);"") توزيع التاريخ 2.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته ربما تقصد جمع قيم العمود بشرط الخلفية الزرقاء تفضل جرب وضع هدا لكود في موديول Function TotalRng(SumRange As Range, SumColor As Range) Dim SumColorValue As Integer Dim SumRng As Long SumColorValue = SumColor.Interior.ColorIndex Set b = SumRange For Each b In SumRange If b.Interior.ColorIndex = SumColorValue Then SumRng = SumRng + b.Value End If Next b TotalRng = SumRng End Function وفي الخلية H17 =TotalRng(البيانات!$H$2:$H$80;K1) مع تلوين الخلية K1 باللون الهدف فرز بيانات ذات اللون 2الازرق.xlsm

تفضل جرب test.xlsm

السلام عليكم ورحمة الله نعالى وبركاته بعد ادن الاستاد أ / محمد صالح بالنسبة لاظهار بيانات اليوم فقط تفضل جرب اخي Private Sub UserForm_Initialize() Dim f As Worksheet: Set f = Sheets("ورقة1") Set d = CreateObject("scripting.dictionary") Col = f.Range("B4:E" & f.[B65000].End(xlUp).Row).Value Rng = UBound(Col, 2) With Me.ListView1 .Gridlines = True .FullRowSelect = True .View = lvwReport .ColumnHeaders.Add , , "code", 0 .ColumnHeaders.Add , , "م", 30, lvwColumnCenter .ColumnHeaders.Add , , "التاريخ", 80, lvwColumnCenter .ColumnHeaders.Add , , "اسم العميل", 120, lvwColumnCenter .ColumnHeaders.Add , , "الرقم ", 60, lvwColumnCenter Cpt = 1 ' من بداية الجدول ' For i = 1 To UBound(Col) For i = UBound(Col) - 19 To UBound(Col) ' تحديد اخر 20 صف If Col(i, 2) = Date Then ' شرط تاريخ اليوم .ListItems.Add , , Col(i, 1) For k = 1 To Rng .ListItems(Cpt).ListSubItems.Add , , Col(i, k) Next k Cpt = Cpt + 1 End If Next i End With End Sub listview 2.xlsm

لعرض آخر 20 ضف يمكنك تغيير هذا السطر في الاجراء showdata For frw = 4 To last إلى For frw = last - 19 To last ولخذف الصف المطلوب Private Sub CommandButton1_Click() If MsgBox("Are you sure you want to delete this item?", vbYesNo, "Confirm Delete") = vbYes Then Rows(ListView1.SelectedItem.ListSubItems(1).Text + 3).EntireRow.Delete showdata End If MsgBox "Done by mr-mas.com" End Sub بالتوفيق

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

اخوانى و احبابى اعضاء المنتدى الكريم السلام عليكم و رحمة الله و بركاته يسعدنى ان اقدم لكم برنامج شامل و كامل لعملية استيراد ملفات الاكسل الى قواعد البيانات اكسس خطوات عمل البرنامج 1- قم بالضغط على زر فتح الفولدر و اختر ملف الاكسل المراد استيراده و بعد اختيار الملف يمكنك فتح الملف من داخل الاكسس بالضغط على زر ( فتح ملف اكسل) 2- قم بالضغط على الكمبو بكس لاختيار ورقة العمل 3- الخطوة رقم 3 خاصة بانشاء جدول جديد لورقة العمل فيجب عليك وضع اسم للجدول ثم اضغط على زر تنفيذ ليتم استيراد ورقة العمل و لعرض بيانات الورقة بعد الاستيراد فى الجدول قم بالضغط على زر عرض و اذا اردت الدخول على وضع التصميم اضغط زر تصميم و اذا اردت حذف الجدول قم بالضغط على زر حذف 4- الخطوة رقم 4 خاصة بوجود جدول تم انشاؤه من قبل و تريد اضافة بيانات الورقة اليه قم بالضغط على الكمبو بكس و اختر الجدول المراد اضافة بيانات الورقة اليه ثم اضغط على زر تنفيذ لعرض الجدول الذى تم اختياره فى الكمبو بكس اضغط على زر عرض و لعرض الجدول فى وضع التصميم اضغط على زر تصميم و لحذف الجدول اضغط على زر حذف ** لرؤية جميع الجداول فى اطار الاكسس اضغط زر اظهار جميع الجداول ** لاخفاء جميع الجداول و اطار الاكسس اضغط على زر اخفاء جميع الجداول و فى الختام لكم منى كل تحية و تقدير اخوكم / علاء الدين محمد النكلاوى مصر - البحيرة ت: 3803009/045 neklawy1968@yahoo.com excel_to_access.rar

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

أستاذة صفاء ، جربي هذا المرفق تفضلي lab (1) (1).accdb