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

السلام عليكم احسنت اخي ابو انس وان شاء الله نرى هذا النشاط بإستمرار ======== حل أخر يمكن استخدام الدالة ضع هذه المعادلة في الخلية G5 ثم اسحب للاسفل =VLOOKUP(E5;$J$12:$L$14;2;0) وهذه لفترة السماح ضعها في الخلية H5 ثم اسحب للاسفل =VLOOKUP(E5;$J$12:$L$14;3;0)

السلام عليكم هذه محاولة مني اضغط على Ctrl + حرف (خ) بالعربي وسيظهر الفورم في اي صفحة وبه القوائم المنسدلة user form.zip

السلام عليكم تم اضافة العمل في موضوع منفصل هنا http://www.officena.net/ib/index.php?showtopic=44003

السلام عليكم ورحمة الله وبركاته طلب احد الاخوة ان يتم تعديل كود موجود لدية (خاص بالاستاذ عبدالله باقشير) ليتم الحذف من خلال فورم الطلب هنا http://www.officena....showtopic=43999 ولكون الطلب اخذ جهد في التنفيذ وتم اضافة ميزة الاضافة من خلال الفورم فقط احببت فصله في موضوع منفصل ==== في الملف المرفق بعد الضغط على Ctrl + حرف (س) بالعربي سيظهر فورم فيه مربع تحرير وسرد وزرين أمر أحدهما غير مفعل في القائمة المنسدلة من مربع التحرير والسرد ستجد أسماء اوراق العمل عند إختيار ورقة عمل (غير مستثناة) والضغط على زر (Delete Sheet) سيتم حذفها أما الزر الاخر فسيتم تفعيله اذا تم اختيار صح في خانة اختيار اضافة ورقة عمل للعلم الاضافة والحذف لن تتم الا عن طريق الفورم دالة التحقق من اسم الشيت وتكراره هي خالصة للاستاذ ( عبدالله باقشير) ===================================================== في المرفق تم إضافة خاصية تغيير شكل الماوس عند مروره بأزرر الامر وهي منقولة للامانة ================================================== ان شاء الله يتم الاستفادة من العمل وشكراً ابو أحمد كود منع حزف ورقه.rar

ياريت ان كان هذا ممكن ان يتم شرح الطريقة والشكر موصول للجميع على هذا الموضوع الرائع

في مرفقك التواريخ الافقية مكتوبة خطاء ويتم التعامل معها بانها تخص شهر يناير وليس نوفمبر قم بكتابة التاريخ بهذه الطريقة 01 ثم 11 ثم انتر ثم اسحب افقياً حتى تاريخ 30/11/2012 ثم فعل الكود في مرفقك وسيعمل ===

السلام عليكم تفضل المرفق تم عمل قائمة منسدلة مرنة وتلقائية في الخلية F4 NOV 12.rar

السلام عليكم ضع هذا الكود في زر أمر Sub MySum() [G4:AJ4].ClearContents For R = 4 To 74 If Cells(R, 2) = [F4] Then For i = 7 To 36 If Cells(R, 3) = Cells(1, i) Then Cells(4, i) = Cells(4, i) + Cells(R, 4) Next End If Next End Sub ثم ضع الاسم الذي تريد في الخلية F4 ثم فعل الكود

السلام عليكم السبب في عدم العمل اذا كان الشهر فبراير في هذا السطر Case "Februrary" والاصح Case "February"

السلام عليكم جرب هذا الكود استبدل الاعمدة بالاعمدة التي تريدها Sub DelCol() Range("A:A,E:E,H:H,J:J").Delete Shift:=xlToLeft End Sub

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

نسأل الله تعالى ان يعز دينه ويجمع امة الاسلام على الحق والهدى ويعيذها من الفتن ما ظهر منها وما بطن ،

هذه تم اضافتها للمنتدى خلال فترة الحج من قبل الاستاذ محمد طاهر

هذه تم اضافتها للمنتدى خلال فترة الحج من قبل الاستاذ محمد طاهر

لا اعلم ما المشكلة فالاداة تعمل بشكل صحيح (اةفيس 2007 وندوز 7)

تم تعديل العنوان ونرجو الالتزام بقواعد المشاركة مستقبلاً

السلام عليكم تم التعديل كما تم اضافة خيار عدم التطابق إستبدل الكود السابق بهذا Function MyFunTest(MyVal1 As Range, MyVal2 As Range) As String For Each C1 In Split(MyVal1) E = E + 1 Next For Each C In Split(MyVal2) Y = Y + 1 For Each C1 In Split(MyVal1) If C = C1 Then R = R + 1: K = K & C & " و ": Exit For Next Next Select Case R Case Is = E MyFunTest = "متطابق 100%" Case Is = Empty MyFunTest = " غير متطابق " Case Else MyFunTest = "متطابق في " & Left(K, Len(K) - 2) End Select End Function

عندما اريد كتابة ((اذا كانت الخلية X فارغة )) فاني اكتب في الكود IF IsEmpty(.Cells(s, 5)) Then وعندما اريد كتابة ((اذا لم تكن الخلية X فارغة )) فاني اكتب ما تسأل عنه ان شاء الله وضحت الفكرة

اليك هذه الروابط http://www.officena.net/ib/index.php?showtopic=39071 http://www.officena.net/ib/index.php?showtopic=41502

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

سلمت لنا استاذ الخالدي على هذا التشجيع الكريم هذا بعض ما عندكم

السلام عليكم بكود الاستاذ نارت ظهر لدي 40 رقم ايضاً لماذا

اليك المرفق تدقيق الاسماء.rar

اليك هذه الدالة المعرفة Function MyFunTest(MyVal1 As Range, MyVal2 As Range) As String For Each C In Split(MyVal2, " ") Y = Y + 1 For Each C1 In Split(MyVal1, " ") E = E + 1 If C = C1 Then R = R + 1: K = K & C & " و " Next Next E = E / Y Select Case E Case Is = R MyFunTest = "متطابق 100%" Case Else MyFunTest = "متطابق في " & Left(K, Len(K) - 2) End Select End Function

السلام عليكم في اكواد الفورم استبدل الكود السابق بهذا Private Sub TabStrip1_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) On Error Resume Next Dim NN As Integer, S As Integer, R As Integer Dim MM As Integer, SS As Integer 'If TabStrip1.Value = 1 Then GoTo 1 NN = 0 TextBox43.Text = "" MM = 2 For SS = 1 To 20 If Me.Controls.Item(MM).Text <> "" Then Me.Controls.Item(MM + 2).Value = Val(Me.Controls.Item(MM).Text) * Val(Me.Controls.Item(MM + 1).Text) TextBox43 = Val(TextBox43) + Val(Me.Controls.Item(MM + 2)) End If MM = MM + 5 Next Label22.Caption = "" & NoToTxt2(Val(TextBox43), "دولار", "سنت") TextBox43 = Format(TextBox43, "#,##0.00") On Error GoTo 0 1 End Sub طبعاً هو حذف لعدد من الاسطر الخاصة بالسعر