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

جرب هذا الماكرو Sub MOVEROWS() lastrow = Worksheets("data").UsedRange.Rows.Count lastrow2 = Worksheets("save").UsedRange.Rows.Count If lastrow2 = 1 Then lastrow2 = 0 Else End If Do While Application.WorksheetFunction.CountIf(Range("Q:Q"), "منتهي") > 0 Set Check = Range("Q1:Q" & lastrow) For Each Cell In Check If Cell = "منتهي" Then Cell.EntireRow.Copy Destination:=Worksheets("SAVE").Range("A" & lastrow2 + 1) Cell.EntireRow.Delete lastrow2 = lastrow2 + 1 Else: End If Next Loop End Sub

تفضل التعديل nabil23221.zip

يرحل ويحدف انزل لاخر الورقة وسترى البيانات لا ادري يوجد مشكلة في التنسيق لم يعجبني تنسيقك في الاعلى يوجد تنسيقات جدول ثم فراغات ثم في الاسفل 😕

تفضل هذا التعديل DATA146.zip

عند الاستيراد تأخذ السجلات المستوردة رقم متسلسل يبدء من A انت حين رفضت التعديل بقت على ماهي عليه دون تعديل فلو وافقت على التعديل لكانت اخذت الرقم الذي تريده الأمر بإختصار شديد في حال ادخلت رقم تم ادخاله مسبقا سوف تظهر رسالة تحذير ( الرقم مكرر هل تريد التعديل على نفس الرقم) أي هل تريد استخدام نفس الرقم ؟ في حال انك قمت بالرفض لن يحدث اي تغيير على المدخلات أرجوا ان تراجع الكود للتأكد من ذلك في حال انك وافق سيتم الاحتفاظ بالرقم المكرر المدخل اي سيتم استبدال الرقم التلقائي و الذي يبدء بحرف A الى الرقم المدخل في حال كان الرقم جديد سيتم تغيير الرقم التلقائي و الذي يبدء بحرف A الى الرقم الجديد ارجوا ان تكون الصورة اتضحت كما أرجوا ان تطلع على الكود لكي تعرف كيف تسيير الأمور

تسويط النص اعتقد انه ما يقبل و تعديل الأعمدة تم ربط مع عدد الأعمدة في الجدول أي زيادة الأعمدة و نقصانها تعمد على حسب جملة الاستعلام Me.SmartList.ColumnCount = rs.Fields.Count

العفو اخي الكريم تفضل هذا التعديل كان فيه خطأ بسيط و تم التعديل عليه ملاحظة هامة اهم عنصرين في عملية الاستعلام هم (D_Obs \ م) في حال اضفت جدول جديد تأكد من اضافة هذين الحقلين (D_Obs \ م) و من ثم اضافة اسم الجدول الجديد في جدول Tabols nabil23223.zip

اتفضل التعديل يابو الحسن اذا الرقم مكرر راح تكون امام خيارين - الاستمرار بالرقم المكرر - رفض الاستمرار بالرقم المكرر DATA145.zip

غير خاصية ShowDropButtonWhen هذه من خصائص الكموبوبوكس الى القيمة 1 مع ملاحظة يجب ان يكون زر الكومبوبوكس من نوع active x

بارك الله فيك اخي د.كاف يار هذا هو المطلوب واكثر ، لك مني كل الثناء و التقدير يعجز اللسان عن شكرك وجزيل الشكر والعرفان لاعضاء وخبراء هذا القسم الرائع لما تقدموهم من دائم و مستمر تمنياتي لكم بالمزيد من الإبداع والتقدم.

تفضل اخي الكريم Dim X As String, Y As String Y = DLookup("[txtMsgBox]", "[tblMsgBox]", "[Id] =1") X = DLookup("[txtMsgBox]", "[tblMsgBox]", "[Id] =2") MsgBox X, vbInformation, Y db0.rar تحياتي ' متغيرات Dim X As String, Y As String ' عنوان الرسالة Y = DLookup("[txtMsgBox]", "[tblMsgBox]", "[Id] =1") ' نص الرسالة X = DLookup("[txtMsgBox]", "[tblMsgBox]", "[Id] =2") ' عرض الرسالة MsgBox X, vbInformation, Y

اخي محمد لن تجد اجابة لكون المنتدى يشدد على احترام حقوق الملكية الفكرية المحظورات 20. يمنع منعا باتا نشر أية موارد تخالف حقوق الملكية الفكرية بما في ذلك الكتب والكراك وتبادل السيريال، والمخالفة تعرض المشاركة للإلغاء والعضوية للإيقاف. تحياتي وتقديري لك اخي الفاضل والحل العملي شراء سيريل

هذي الاشكالية تم حلها مسبقا

جرب هذا الشيء لعله يفيدك Private Sub TextBox1_AfterUpdate() If Application.WorksheetFunction.CountIf(Worksheets("DATA").Range("A2:A10000"), TextBox1.Text) > 0 Then MsgBox (" عفوا رقم السجيل مكرر"), vbInformation Cancel = True End If TextBox1.Value = "" End Sub

السلام عليكم ورحمة الله وبركاته انظر لهذا الملف يمكن يفي بالغرض لم اجرب الملف بالتوفيق إن شاء لله 33333.rar

بارك الله فيك اخي د.كاف يار اخي د.كاف يار النموذج fr_emply خاصة بادخال البيانات الحالات الخاصة هل ممكن عمل عملية التصفية للحالات الخاصة ( استيداع ، ترقية ، تقاعد ، استقالة ...... الخ ) في نموذج واحد مستقل و تكون التصفية خلال السنة مثلا اختار استيداع و اختار السنة 2020 يظهر لي جميع الموظفين الذين احيلو على الاستيداع خلال السنة و هكذا مع باقي الحالات .

تفضل التعديل اخي nabil2322.zip

طيب اتفضل هذا التعديل DATA144.zip

السلام عليكم اعادة صيغة الارقام.xlsx

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

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

جرب هذا الكود Option Explicit Sub Colorize_Range() 'Created By Salim Hasbaya 9/6/2109 Dim i%, x%, k%, m%, My_ad$, First_ad$ Dim My_rg As Range, cel As Range Set My_rg = Range("a1:G12") Dim f_rg As Range x = 4 My_rg.Interior.ColorIndex = xlNone For Each cel In My_rg If cel.Interior.ColorIndex <> xlNone Or _ Application.CountIf(My_rg, cel) = 1 Then _ GoTo next_cel Set f_rg = My_rg.Find(cel, lookat:=xlWhole) My_ad = f_rg.Address: First_ad = My_ad Do Range(My_ad).Interior.ColorIndex = x Set f_rg = My_rg.FindNext(f_rg) My_ad = f_rg.Address Loop Until My_ad = First_ad x = x + 1: If x = 57 Then x = 10 next_cel: Next cel End Sub الملف مرفق CororisMe.xlsm