عبدالله المجرب

البرنامج تم عمله بطريقة متقنة وتم جعله غير مفعل هل من اعطاك اياه هو المالك الحقيقي للبرنامج لان حقوق الملكية الفكرية تمنعنا من القيام بتفعيل البرنامج

لم اشاهد المرفق الخاص بك === في محرر الاكواد ضع هذا الكود Private Sub M2_AfterUpdate() M1.SetFocus DoCmd.GoToRecord , , acNewRec End Sub

السلام عليكم هل تقصد هكذا ابواحمد.rar

اخي عبد السلام احسنت في التوضيح

ما شاء الله تبارك الله عمل متكامل ومميز

رائعة جداً استاذ محمود سلمت يمينك

بارك الله فيكم استاذ بن علية واستاذ محمود لي على جهودكما

الموضوع قديم

السلام عليكم بعد إذن الاستاذ رجب هذا اختصار للكود واضافة نص الرسالة باللغة الانجليزية Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A2:A" & [A1000].End(xlUp).Row)) Is Nothing Then If Application.CountIf(Range("A2:A" & [A1000].End(xlUp).Row), Target) > 1 Then If MsgBox("Same Value Available in Cell" & Chr(10) & arr & Chr(10) & "Repeat Same Value again", vbYesNo, "Repeated Value") = vbYes Then Exit Sub Target = "": Target.Select: Exit Sub End If End If End Sub

بارك الله فيك استاذ ابو خليل

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

الف مبروك الترقية المستحقة وان شاء الله من حسن الى احسن ابو احمد

السلام عليكم لم افهم الطلبين الاخرين بخصوص الاخفاء والاظهار شاهد المرفق TEST DATA.rar

اتقدم بالاصالة عن نفسي ونيابة عن جميع الاعضاء بالتهنئة الى الاخ الكريم رجب جاويش بمناسبة ترقيته الى خبير معتمد وان شاء الله نرى فيه النشاط المعهود دائماً === سينقل الموضوع الى المنتدى الاجتماعي بعد فترة

مبروك اخي رجب الترقية الجديدة شكراً اخي محمود لي وتواجدي قل بسبب محاولتي تعلم الاكسس ووجودكم يكفي ويزيد بارك الله فيكم == بخصوص الصورة ساعيد وضعها فيما بعد

بارك الله فيكم اخواني الكرام رجب جاويش ومحمود لي

الملف معمول باصدار 2010 ولا يعمل على 2007 او 2003 ارفق الملف بصيغة 2003 وستجد العون ان شاء الله

ضع هذا الكود في محرر الاكواد الخاص بالفورم Private Sub Command0_Click() If DCount("[name]", "emp", "[name] = 'محمد'") <> 0 Then MsgBox "مرحبا" Else MsgBox "الاسم ليس محمد" End Sub

جرب المرفق بعد التعديل اختيار واحد فقط .rar

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

بارك الله فيك استاذ بن عليه

لا شكر على واجب

استخدم الدالة sumif

السلام عليكم Dim LastRow As Long Dim rngCriteria As Range, rngValue As Range التعريف عن متغيرات =============== LastRow = Cells(Rows.Count, "D").End(xlUp).Row لاستخراج رقم أخر صف به بيانات (في مثالك 13) ======= Set rngCriteria = Range("D2:D" & VBA.CStr(LastRow)) تعريف المدى من D2 الى D و أخر صف به بيانات ===== Set rngValue = Range("F2:I" & VBA.CStr(LastRow)) تعريف المدى من F2 الى I و أخر صف به بيانات ======================= Application.ScreenUpdating = False إيقاف اهتزاز الشاشة === With rngCriteria .Offset(0, 2).FormulaR1C1 = "=SUMIF(Kind,RC[-2],Sales)" .Offset(0, 3).FormulaR1C1 = "=SUMIF(Kind,RC[-3],Purchases)" .Offset(0, 4).FormulaR1C1 = "=SUMIF(Kind,RC[-4],SalesRefunds)" .Offset(0, 5).FormulaR1C1 = "=SUMIF(Kind,RC[-5],PurchasesRefunds)" End With هذه الجزئية ساتناول السطر .Offset(0, 2).FormulaR1C1 = "=SUMIF(Kind,RC[-2],Sales)" والباقي بنفس الفكرة في المدى D2:D واخر صف فاضي والذي تم تعريفه بهذا الاسم (rngCriteria) الخلايا المزاحة بمقدار عمودين يتم وضع هذه الصيغة (دالة ) فيها "=SUMIF(Kind,RC[-2],Sales)" وكما هو معروف بالنسبة لدالة SUMIF وطريقة عملها مع العلم ان المدى Kind والمدى Sales تم تعريفهما مسبقاً =========================== rngValue.Value = rngValue.Value هذا السطر يعني ان قيمة المدى من F2:I واخر خليه بها بيانات التي تم جلبها بالدالة يتم استبدال الدالة بالقيمه الناتجة عنها جرب مسحه وسترى ان الخلايا تحوي معادلات ================ ان شاء الله ان اكون وفقت في الشرح

بصراحة طلبك غير مفهوم هل تريد عمل نموذج في ورقة ام تريد عمل الية لتوزيع النوبات