أبو حنــــين

او بالطريقة التالية Private Sub TextBox1_Change() With TextBox1 .MaxLength = 10 Art = Array(2, 5) For i = 0 To UBound(Art) If Len(.Value) = Art(i) Then .Value = .Value & "-" Exit For End If Next End With End Sub Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii < 46 Or KeyAscii > 57 Then KeyAscii = 0 End Sub

السلام عليكم يمكن عمل ذلك لكن بشرط ان تكتب اليوم برقمين مثلا 1 تكتب 01 و الشهر مثلا 2 يكتب 02 فكل من الكودين التاليين يعملان بهذه الطريقة مثال عوض ان تكتب : 1-2-2013 تكتب 01-02-2013 طبعا بدون الاشارة ( - ) الكود الاول Private Sub TextBox1_Change() If Len(TextBox1) = 2 Then TextBox1.Value = TextBox1.Value & "-" If Len(TextBox1) = 5 Then TextBox1.Value = TextBox1.Value & "-" End Sub الكود الثاني Private Sub TextBox1_Change() Art = Array(2, 5) For i = 0 To UBound(Art) If Len(TextBox1) = Art(i) Then TextBox1 = TextBox1 & "-" Exit For End If Next End Sub

جزاك الله خيرا أخي الأستاذ حمادة اشتقنا إليك و الله ندعو الله ان تكون في تمام الصحة

السلام عليكم بعد اذن الاخوة الكرام هذا تصوري للاجابة هناك جدول للدرجات و الوصف يمكن التحكم به QUESTION1.rar

أخي إبراهيم جزاك الله خيرا

السلام عليكم جرب المرفق مع العلم انني غيرت اسماء الشيتات لكي تتوافق مع الاسماء الموجودة في العمود C Fin.rar

اخي ابراهيم جزاك الله خيرا على المرور اخي Omar هذا هو الملف Book1.rar

السلام عليكم هذا المرفق يحتوي على ساعة ساعة.rar

جزاك الله خيرا أخي حمادة باشا على مروركم حفظكم الله و رعاكم

السلام عليكم شاهد المرفق مثال.rar

السلام عليكم المرفق كما طلبت ان شاء الله Book1.rar

السلام عليكم العفو اخي هذا تصحيح لخلل بسيط Book1_.rar

السلام عليكم هذا مرفق لما طلبت تحياتي Book1 .rar

السلام عليكم اصافة لما تفضل به اخي عبد الله واثراءا للموضوع يمكن استعمال الكود Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsDate(TextBox1) Then TextBox2 = Format(DateAdd("d", 30, TextBox1), "dd-mm-yyyy") End Sub

السلام عليكم قم بضغط الملف ببرنامج ضغط مثل الونرار ثم ارسله

السلام عليكم تم استدراك الخطأ الذي ذكره الأخ kashcool فوروم حذف وإضافة - سعيد بيرم.xlsx.rar

السلام عليكم هذا الملف بعد وضع الكود اعتقد ان الحماية بكلمة مرور افصل و السبب هو عند الضفط على وضع التصميم ( المثلث الأزرق في شريط العناوين ) فان الكود لا يعمل Rank Total Area_.rar

السلام عليكم ضع هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(ActiveCell, [a1:iv36536]) Is Nothing Then If ActiveCell.HasFormula Then With Application .EnableEvents = False: .Undo: .EnableEvents = True End With End If End If End Sub

السلام عليكم بعد اذن اخي حمادة يمكن استعمال الكود التالي Private Sub Command1_Click() Dim xl As New Excel.Application Dim xlw As Excel.Workbook Dim i As Integer, Lr As Long Set xlw = xl.Workbooks.Open(App.Path & "\my.xls") xlw.sheets("bob").Select Lr = xlw.Application.sheets("bob").cells(Rows.Count, "A").End(xlUp).Row For i = 1 To List1.ListCount xlw.Application.cells(Lr + i, 1).Value = List1.List(i - 1) xlw.Application.cells(Lr + i, 2).Value = List2.List(i - 1) xlw.Application.cells(Lr + i, 3).Value = List3.List(i - 1) Next xlw.Save With xl .Visible = False .Application.Quit End With Set xlw = Nothing Set xl = Nothing End Sub

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

السلام عليكم جرب المرفق حساب الصندوق_.rar

السلام عليكم يمكن استعمال احدى الدالتين 1 =IF(LEFT(F4;LEN($A$4))=$A$4;1;IF(LEFT(F4;LEN($A$5))=$A$5;1.5;IF(LEFT(F4;LEN($A$6))=$A$6;2;""))) 2 =IF(LEFT(F4;4)="مدير";1;IF(LEFT(F4;5)="مساعد";1.5;IF(LEFT(F4;3)="عام";2;"")))

السلام عليكم اخي سعيد بيرم جرب الملف و اخبرني بالنتائج فوروم حذف وإضافة بيانات مع إدراك صفوف والمعادلات لاكثر من ورقة.xlsx.rar

استدراك المعادلة التالية موجودة في شيت 2 =OFFSET(DATA!D$2;MATCH(SMALL(DATA!A$2:A$1000;ROW()-ROW(DATA!P$2)+1);DATA!A$2:A$1000;0)-1;0) يجب استبدالها بالمعادلة التالية و سحبها للاسفل =IFERROR(OFFSET(DATA!D$2;MATCH(SMALL(DATA!A$2:A$1000;ROW()-ROW(DATA!P$2)+1);DATA!A$2:A$1000;0)-1;0);"")

المعذرة اخي محمود لم ارى ردك إلا بعد ما قمت بارسال ردي