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

للرفع

السلام عليكم اخي يوسف جرب هذا الكود قبل الفورمات فان كان الرقم لا يتغير امكننا التحكم في فتح الملف على كمبيوتر محدد Sub Abu_Ahmed() MsgBox CreateObject("Scripting.FileSystemObject").GetDrive("c:\").serialnumber End Sub

كود التفعيل سيكون فريد ولا يتكرر لجهازي حاسب وكود تفعيل جهازك هو في الجزء الاول الرقم صفر وليس حرف O 0VMA JRKD 6JKJ LFQP

إستخراج كود التفعيل يتم عن طريق برنامج به أكواد تستخرج هذه الارقام العلاقة بالرقم الموجود هو ان هذا الرقم الذي ظهر امامك لا يتكرر مرتين لاي جهاز فيقوم الكود في البرنامج بطريقة حساب معينة بإستبدال هذه الارقام برموز من 16 مقطع

البقاء لله وان لله وان اليه راجعون

أقصد بان ليس لدي خلفية عن هذه الريفينسات == سيكون كود التفعيل لكمبيوترك هو 1. NRP6 2. JYPX 3. 23FG 4. P4FL يوضع بالترتيب ابتداءاً من اليسار

السلام عليكم هذه الدالة لحساب الفردية =SUM(IF(MOD(A1:A10;2)=1;A1:A10)) وهذه للزوجية =SUM(IF(MOD(A1:A10;2)=0;A1:A10)) لكن لا تنسى الضغط على Ctrl+Shift + Enter معاً

بارك الله فيك اخي زوهير وجعله الله في موازين أعمالك

ما المسئول بأعلم بها من السائل === هل عمل معك الفورم اذا كان نعم الرجاء وضع الرقم ليتم تزويدك بكود التفعيل لتجربته

شاهد المرفق report.rar

السلام عليكم تم تعديل الكود ليصبح Sub report1() Application.ScreenUpdating = False On Error Resume Next Set Mysh = Sheets("مشتريات") Range("B7:H47").ClearContents If [F3] = "" Then DateFrom = CDate(Application.Min(Mysh.[E5:E20])) Else DateFrom = [F3] If [I3] = "" Then DateTo = CDate(Application.Max(Mysh.[E5:E20])) Else DateTo = [I3] '======================================================== For r = 5 To Mysh.[b10000].End(xlUp).Row If [C3] = Mysh.Cells(r, 6) And Mysh.Cells(r, 5) >= DateFrom And Mysh.Cells(r, 5) <= DateTo Then Mysh.Cells(r, 2).Resize(1, 7).Copy Range("B" & [b10000].End(xlUp).Row + 1) End If Next r Set Mysh = Nothing End Sub

جرب المرفق system user.rar

تجد ما تريد (حسب فهمي) في الكود MySub فهو يلغي حدث الصفحة ثم يفعله تم عمل الزرين الرجاء التجربة إيقاف.rar

السلام عليكم اتبع الخطوات التالية قم بفتح ملف اكسل جديد 2. ارفع امان الماكرو 3. افتح ملف اكسل فورم التفعيل (ستظهر لك شاشة رمادية) 4. اضغط Alt + F11 5. سيطلب منك كلمة سرية لفتح محرر الاكواد الخاص بالملف (a1234a) هذه هي الكلمة 6. قم بإزالة هذه الحماية 7. احفظ قم بخفض أمان الماكرو بفتح اي ملف اخر قم بفتح الملف ستظهر لك رسالة الخطاء اذهب الى محرر الاكواد بالضغط على Debug بعدها اتبع خطوات الصورة ثم قم بإزالة الصح من Missing ريفرنس

ممكن ان تضع شرط الكود بقيمة خلية فاذا كانت 1 يعمل الكود واذا كانت غير ذلك ليكن 5 يتوقف انا افترضت الخلية AA2 Private Sub Worksheet_Selectionchange(ByVal Target As Range) If [AA2] = 1 Then GoTo 1 Else: Exit Sub End If 1: If Not Intersect(Target, Range("ad2:ae2,aj5:an50")) Is Nothing Then Cells(Target.Row, 30).Select If Not Intersect(Target, Range("r4:x4,c2:x2")) Is Nothing Then Cells(Target.Row, 1).Select End Sub

الخطاء في احد الريفرنسات المفقودة

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

السلام عليكم تفضل المرفق 22.zip

بس الموضوع لا يتعلق بالحماية بقدر فكرة كود التفعيل فاتمنى من الجميع المشاركة والتفاعل

على نفس رابط السؤال تم وضع محاولة

السلام عليكم بعد المحاولة تم عمل المطلوب في المثال الثاني تم ابعاد القوائم مقدار 10 أعمدة يجب ان يكون هناك تعليق في الخلية (غير مهم ما هو التعليق) شاهد المرفق فورم ادخال و تعديل مرن.rar

كنت أعرف واستميحك عذراً في ازالة المرفق ليتم تجربة البرنامج

السلام عليكم تم عمل اللازم تسلسل خاص.rar

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

هل القائمة المنسدلة في خانة واحدة فقط ام عدة خانات