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

إسم الملف: فورم تفعيل الملف لمرة واحدة أضيف للمكتبة بواسطة: عبدالله المجرب تاريخ الإضافة: 16 Nov 2012 القسم فى المكتبة: قسم الإكسيل السلام عليكم ورحمة الله وبركاته الفكرة: قبل مدة عرضها علي الاستاذ محمد صالح مطبقة في ملف اكسل فاحببت ان اجربها بلامس فطلبتها منه لكنه فضل ان اصل اليها مع اعطائي رابط مساعد من منتدى زميل. الهدف: ملف سيطلب التفعيل كلما تم نقله الى حاسب اخر وتكود اكواد التفعيل ال16 مختلفة لكل حاسب ونهدف منها الى حماية البرامج من النقل والاستخدام الغير مرخص من قبل المبرمج. التنفيذ: تطلب التنفيذ بعض الوقت والمحاولات حتى الوصول الى هذه النتيجة فكرة: ارجو التجربة وابداء الراي. طريقة طلب كود التفعيل: سيظهر لك فورم فور عمل البرنامج في المربع الاول هناك نص يتم وضعه في المشاركة ليتم اعطائك كود التفعيل للبرنامج المشاركون في التنفيذ: 1. صاحب الفكرة ومنفذها على ملف اكسس في منتدى الفريق العربي للبرمجة (أكسير الحياة ومعه الاستاذة المعروفة زهرة العبدالله) 2. الاستاذ محمد صالح 3. الاستاذ عبدالله باقشير (كود عدم عمل الملف اذا كان الماكرو غير مفعل له) 4. العبد الفقير الى الله اخوكم في الله عبدالله المجرب بالتنفيذ وقليلاً من اللمسات . ====== ملاحظة الملف لن يطلب التفعيل الا مرة واحدة مع وجود خيار للحصول على طريقة التفعيل بواسطة المعلومات الموجودة في الفورم ومن خلال هذه المشاركة طبعاً تم ارفاق الملف لسهولة التحميل من المشاركة إضغط هنـــــــــــا لتنزيل الملف ملف يطلب كود تفعيل لفتحه ولمرة واحدة فقط.rar

ان شاء الله ممكن إستبدل كود زر الحذف بهذا Private Sub CommandButton1_Click() Dim sh As String, T As Integer If ComboBox1 = "" Then MsgBox "لا يمكن إتمام العملية لعدم وجود إسم": Exit Sub Application.DisplayAlerts = False sh = ComboBox1.Text ActiveWorkbook.Unprotect "1" Select Case sh Case "عبدالله", "116" ''''''''''''''''''''''' Case Else: T = 1: Sheets(sh).Delete End Select MsgBox IIf(T, "تم حذف الشيت " & sh, "لم يتم الحذف لانه محمي"), vbOKOnly, "تنبيه" ActiveWorkbook.Protect "1", Structure:=True, Windows:=False Unload Me End Sub

شكراً للجميع على التشجيع واخص بالذكر الاستاذ عبدالله باقشير فهو من نقتبس منه هذه الاعمال ======

ضع هذا الكود في حدث thisWorkBook Private Sub Workbook_Open() Sheets("اسم الورقة الرئيسية").Select End Sub

السلام عليكم احسنت اخي ابو انس وان شاء الله نرى هذا النشاط بإستمرار ======== حل أخر يمكن استخدام الدالة ضع هذه المعادلة في الخلية 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

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

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