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

وعليكم السلام ورحمة الله تعالى وبركاته تفضل جرب Sub compter() Dim i& Dim sh As Worksheet: Set sh = Worksheets("ورقة1") a = [j2] b = [k2] On Error Resume Next For i = a To b If IsNumeric(b) = True And a >= 1 Then [A1] = a Application.Wait (Now + TimeValue("00:00:03")) a = a + 1 Else Exit Sub End If Next i On Error GoTo 0 End Sub

تفضل برنامج ادارة خدمات عقار (1).xlsm

تفضل عمل احصائية.xlsm

السلام عليكم اهداني اخي العزيز @حسونة حسين ملف اكسل يحتوي على جميع مواضيع منتدى اكسس وبروابط مباشرة اضعه بين ايديكم لا تنسونا من دعوات صالحات *********************** ( إضافات للموضوع - Moosak ) قمت بعمل تصميم بسيط لنموذج البحث وأضفته إلى الموضوع الرئيسي بعد أذن أستاذنا أبو خليل 🙂 بمجرد الكتابة تظهر النتائج .. لاستعراض الموضوع يتم الضغط على العنوان مباشرة النقر المزدوج على مربع البحث يعيد إظهار جميع النتائج 🙂 يمكن البحث بكلمات متفرقة في الجملة .. Search_Officena_Access.rar ********************************************** Access.rar

اعرض الملف ملف اكسل ضريبة كسب العمل ( الضريبة على الدخل ) طبقًا للقانون المصرى الجديد 30 لسنة 2023 Income Tax July-2023 -Essam Mosaad.xlsx صاحب الملف عصام مسعد تمت الاضافه 14 يول, 2023 الاقسام قسم الإكسيل

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

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

جرب BASE2023(2).accdb

وعليكم السلام ورحمه الله جرب الكود التالي لعله المطلوب Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'تحديد الخلية النشطة Dim sel_r As Integer, sel_c As Integer sel_r = ActiveCell.Row sel_c = ActiveCell.Column 'حماية الشيت و فتح الخلايا من B1 إلى صف 653 في نفس العمود النشط ActiveSheet.Unprotect If sel_c = Range("B1").Column And sel_r <= 653 And sel_r >= Range("B1").Row Then ActiveSheet.Protect MsgBox "هذه الخلية محمية" Else ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End If End Sub

انا لله وانا اليه راجعون البقاء لله غفر الله له واسكنه فسيح جناته

وعليكم السلام ورحمه الله

السلام عليكم ورحمه الله راجع الموضوع ادناه لعله المطلوب

طريقة اخرى للاحصائية السابقة ....

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× انتهاك حقوق الملكيه ×××××××× يغلق ××××××××

تفضل 20500-5000.xlsx

البقاء لله وحده اللهم اغفر له وارحمه واسكنه فسيح جناتك

تعليق لاخونا العزيز شايب في برامج المبيعات يتطلب وجود جدول واحد للاصناف او اكثر حسب طريقة المبرمج مثلا جدول الاصناف وجدول ترميز الاصناف وطلب الاستاذ ابو عبد الرحمن ادراج صنف في فاتورة المبيعات خارج قائمة الاصناف المتوفرة امر غير مالوف الا اذا كان المقصود في حالة عدم وجود الصنف يتم ادحاله مباشرة في الفاتورة ويحفظ ايضا في جدول الاصناف وهذا ايضا قد يسبب مشكلات من حيث تكرار اصناف باسماء مختلفة مثل زيت زيتون واخر زيت الزيتون .... وهكذا وايضا قد يحصل صنف واحد على اكثر من كود للصنف بينما يفترض بكود الصنف ان يكون معرف فريد للصنف ايضا من مروري بشكل سريع على البرنامج وجدت انه تم استخدام دالة DLookup في حدث بعد التحديث للقائمة بهذا الشكل Me.SellingPrice = DLookup("[SellingPrice]", "TaItems", "ItemID=" & [ItemName]) Me.SellingPrice2 = DLookup("[SellingPrice]", "TaItems", "ItemID=" & [ItemName]) Me.ItemDiscount = DLookup("[ItemDiscount]", "TaItems", "ItemID=" & [ItemName]) Me.PurchasPrice2 = DLookup("[PurchasPrice]", "TaItems", "ItemID=" & [ItemName]) Me.SellingPrice2 = DLookup("[SellingPrice]", "TaItems", "ItemID=" & [ItemName]) Me.ItemDiscount2 = DLookup("[ItemDiscount]", "TaItems", "ItemID=" & [ItemName]) Me.LowestPrice2 = DLookup("[LowestPrice]", "TaItems", "ItemID=" & [ItemName]) اي كاننا ننفذ سبعة استعلام عند ادراج كل صنف بينما كان يمكننا تحميل قيمة الحقول السبعة بامر واحد وسبق شرحه في الموقع او الاستغناء عن DLookup بتحميل قيمة الحقول السبعة عن طريق الاستعلام ثم اسناد قيمة كل حقل بحسب موقعة في القائمة me.ItemName.Column(0) me.ItemName.Column(1) me.ItemName.Column(2) وهكذا وجهة نظر ونترك الامر للاساتذة والخبراء الاخ شايب 🌹

Try Private Sub CommandButton1_Click() Dim mySum As Double, i As Long With Me.ListBox1 For i = 0 To .ListCount - 1 mySum = mySum + Val(.List(i, 1)) Next i End With Me.TextBox1.Value = mySum End Sub

وعليكم السلام تفضل الفرق بين تاريخين.xlsx

وعليكم السلام ورحمة الله وبركاته إن كنت تريد البحث والتعديل إليك هذه الملفات الأول: استخدام أكواد البحث والتعديل على شيت الاكسيل الثاني والثالث: يوزر فورم بحث وتعديل... برنامج إدخال بيانات لطلاب الدراسات العليا.xlsm فورم اضافة ومسح وحذف وتعديل و بحث بعدة طرق مختلفة.xlsm يوزر فورم - يقبل البحث والاضافة والتعديل والحذف.xlsm

السلام عليكم : اعضاء المنتدي من خبايا الرقم القومي . صممت هذ البرنامج وبدون اكواد لان في اعضاء كتير يحتاجون هذه المعلومات . الصورة توضح اكثر ... my_data.xlsx

السلام عليكم تنقل بين الصفحات بكود من سطر واحد⚽ كود.xlsm

وهدا اخر ملف قمت برفعه دون ان اغير اي شيء في الاكواد فقط حاول جعل الاسماء الغير معدلة درجاتهم في اخر قائمة الاسماء لكي يتطبق شرط وجود الاسماء المعدلة بشكل متتابع وسوف يشتغل معك الكود بشكل صحيح ‏‏مطابقة درجات V2.xlsm

السلام عليكم ورحمة الله وبركاتة ....................................... كل عام وحضراتكم بخير وصحه وعافية رفعت هذا البرنامج للفائدة برنامج محاسبة العمال بالدقيقة 🕒 البرنامج سهل الاستخدام يتم اصافة عميل -حذف عميل .. كما يوجد شيت داخل البرنامج لشرح استخدامة صورة توضيح الاستتخدام هنا الصفحة الرئسية هنا الصفحة المنسوخ منها صفحة العميل الجديد وهذة صفحة شرح كيفية استخدام البرنامج البرنامج في المرفقات برنامج محاسبة العامل بالساعة-1-6-2023-.xlsb

العفو اخي الكريم بما انني استطعت استعاب المطلوب اليك الكود النهائي للملف ربما اسرع عند انشاء عدد كبير من اوراق العمل Public Sub MH_2() Dim ws As Worksheet, WS1 As Worksheet Dim arr As Variant, MH1 As Variant Dim lngArr As Long, lr As Long Dim MH2 As String Dim rngCell As Range temps = Timer 'باستثناء الاوراق التالية MH2 = "Vehicle,Data,Sample" Set WS1 = Sheet1 lr = WS1.Range("H" & WS1.Rows.Count).End(xlUp).Row arr = WS1.Range("H2:H" & lr).Value Application.ScreenUpdating = False ' اظهار النمودج Sheet2.Visible = True 'حدف اوراق العمل For Each ws In Worksheets If InStr(1, MH2, ws.Name) = 0 Then MH1 = Application.Match(ws.Name, arr, 0) If IsError(MH1) Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End If End If Next ws ' نسخ For lngArr = LBound(arr) To UBound(arr) If Len(Trim(arr(lngArr, 1))) > 0 Then If Not Evaluate("ISREF('" & arr(lngArr, 1) & "'!A1)") Then Worksheets("Sample").Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = arr(lngArr, 1) ' تسمية اوراق العمل Range("i19").Value = arr(lngArr, 1) '("i19") اضافة اسم ورقة العمل للخلية ' End If End If Next lngArr ' حدف الارتباطات السابقة With Sheet1 .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)).ClearContents Set rngCell = .Range("B2") End With 'إنشاء ارتباطات تشعبية على بيانات الاوراق الجديدة For Each ws In ActiveWorkbook.Worksheets If InStr(1, MH2, ws.Name) = 0 Then rngCell.Hyperlinks.Add Anchor:=rngCell, Address:="", SubAddress:="" & ws.Name & "!A1" & "", ScreenTip:="", TextToDisplay:=ws.Name Set rngCell = rngCell.Offset(1) End If Next ws Set rngCell = Nothing Set WS1 = Nothing ' اخفاء النمودج Sheet2.Visible = False Sheet1.Activate Application.ScreenUpdating = True MsgBox "تم انشاء" & " " & Application.Sheets.Count - 3 & " " & "ورقة عمل جديدة " & "-" & "تم تنفيد الكود في: " & Format(Timer - temps, "0.0000") & "ثانية", Exclamation, "Officena" End Sub Personal_V2.xlsm

وعليكم السلام ورحمة الله وبركاتة ضع الفولدر المسمي تخزين علي برتيش D ....وان ارت تغير الموقع يكن من هنا ... FName = "d:\تخزين\" واستخدم الملف المسمي Main من اي مكان تفضل تخزين.rar

اتفضلى يا استاذه progressbar.accdb

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

أخي الحبيب عبد العزيز السر في الاسم (يا سر ...) تقبل وافر تقديري واحترامي

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

السلام عليكم و رحمة الله وبركاته gold.rar