عادل حنفي

السلام عليكم اخي نادر لك الشكر و اخي النوع الساكت ان لم تستوعب كلام الاخ نادر اخبرنا بذلك و سيتم الشرح بتوضيح اكبر علي فكره الكود كان به خطأ بسيط تم تعديله بالاعلي و عموما ها هو مرة اخري Private Sub Workbook_Open() sheets("اسم الشيت المراد ان يفتح الملف عليه").activate End Sub تحياتي

عذرا اخي hofn لم اري مشاركتك الا بعد رفع الملف تحياتي

السلام عليكم اخي ارجو ان يكون هذا هو المطلوب mazan.rar

السلام عليكم اخي نادر كليك يمين علي الملف الموجود عندك باسم برنامج الإخفاء.bat و اختار ُُEdit وابحث في السطور عن هذا السطر set/p "pass=>" ( 1962 ) وعدل ال 1962 الي اي شيئ تريد فيكون هذا هوالباسورد الجديد لك تحياتي و عذرا كده البرناج اضرب متزعلش خيرها في غيرها تحياتي

السلام عليكم يمكنك حل الموضوع كما في المرفق تحياتي if.rar

السلام عليكم من محرر الاكواد وفي محرر اكواد ThisWorkbook يتم وضع الكود التالي Private Sub Workbook_Open() sheets("اسم الشيت المراد ان يفتح الملف عليه").activate End Sub تحياتي

السلام عليكم اخي نادر اؤيدك البرنامج جميل و اعمل به من فترة ليست صغير و لكن يعيبه انه يمكن قرائة الباسورد من شخص لديه خبره بالكمبيوتر و بالتالي اظهار الملفات المخفيه ومشكور علي المجهود تحياتي

السلام عليكم اخي تفضل تحياتي printCustomer.rar

السلام عليكم اخي الفاضل نادر اشكرك علي كلماتك اخي الفاضل خبور بعد تنصيب البرنامج قم بفتحه اما ان يطلب منك الباسورد و اما ان تذهب الي help و اختر منهاEnter Activation code ستظهر لك قائمه و بها رقم النسخه انسخه و افتح ملف ال kyegen المرفق مع البرنامج وامام كلمة :HWID حدد الاتي بالماوس Your Computer Code comes here والصق ما تم نسخه سابقااما ان يظهر لك السيرال مباشرة امام كلمة :Serial اواضغظ علي كلمة Generate ليظهر لك السيريال انسخه و الصقه في المكان المحدد بالبرنامج و اضغط علي موافق و اقفل البرنامج الاساسي و افتحه مرة اخري و للتاكد من ان البرنامج تم عمل ال Activation له اذهب الي Helpe مرة اخري ستجد جملة Enter Activation code غير مفعله هكذا يتم عمل البرنامج بوظائفه كاملا و علي فكره انا لاحظت شيئا بالبرنامج ارجو التجربه و اخباري هل هي صحيحة ام لا و هي ان البرنامج الذي قمت بعمل ملف exe و password له يعمل الماكرو الخاص به حتي و لو كان مستوي الامان بالجهاز في الوضع High ارجو ان اكون قد استطعت توصيل المعلومه بطريقة صحيحة تحياتي

السلام عليكم اخي الفاضل جرب المرفق و اخبرني النتيجة كما يمكنك التغيير بالكود لعمل اي عدد من التذاكر تحياتي اخي طارق عذرا لم ار ردك الا بعد ما تم ردي تعديلات حوافز.rar

السلام عليكم اخي ياسر بارك الله فيك لم ار الموضوع من قبل لانشغالي لكنه واضح جهدك فيه فاكمل و لا تياس و الجميع وراؤك و ادعو لنا ان نساهم معكم و لو بالقليل في انتظار تكملتك للموضوع خالص تحياتي و تقديري

السلام عليكم اخي الفاضل خبور اعذرني كان المفروض ان ارد من يومين و لكن كان عندي مشكله بالنت عموما بالفعل لعبه جميله ونتمني ان نتقن مثل هذه الاعمال بارك الله فيك تحياتي

السلام عليكم اخي جرب الملف المرفق ارحو ان يكون المطلوب تحياتي الكود: Private Sub Worksheet_Selectionchange(ByVal Target As Range) Application.ScreenUpdating = False For i = 1 To 1000 Cells(i, 3).Interior.ColorIndex = Cells(i, 1).Interior.ColorIndex Next Application.ScreenUpdating = True End Sub cell color.rar

السلام عليكم اخي abusarah73 مشكور اخي علي كلماتك اخي aitlahbib شوف الملف المرفق و اخبرني النتيجه والكود المستخدم هو Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.Column > 31 Then Exit Sub Application.ScreenUpdating = False x = Target.Column If Cells(1, x).Value = "*" Then GoTo 1 Else GoTo 2 End If 1: m = Cells(2, x).Address n = Cells(50, x).Address Application.ScreenUpdating = False Range(m, n).Interior.ColorIndex = 4 Application.ScreenUpdating = True Exit Sub 2: m = Cells(2, x).Address n = Cells(50, x).Address Application.ScreenUpdating = False Range(m, n).Interior.ColorIndex = xlNone Application.ScreenUpdating = True End Sub تحياتي column color.rar

السلام عليكم اخي الكود بعد التعديل وفقا لطلبك Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub Application.ScreenUpdating = False If Range("a1") = "*" Then GoTo 1 Else GoTo 2 End If 1: Application.ScreenUpdating = False Columns("a:ae").Interior.ColorIndex = 4 Application.ScreenUpdating = True Exit Sub 2: Application.ScreenUpdating = False Columns("a:ae").Interior.ColorIndex = xlNone Application.ScreenUpdating = True End Sub مرفق ملف بالتعديل COLUMN COLOR.rar

السلام عليكم اخي الحبيب احمد يعقوب قبل الاطلاع علي العمل فمعروفة النتيجة مسبقا للتيقن من جودة اعمالك وفي انتظاراكمال ماتصبو اليه خالص تحياتي

السلام عليكم اخي هذا هو الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 8 Then Exit Sub If Range("J2") = 6 Or Range("J2") = 7 Then MsgBox ("الرسالة التي تريد") & " " & Range("I2").Text End If End Sub و للوصول لمحرر الاكواد عن طريق ALT+F11 ستجدقائمة علي اليسار باسماء اوراق العمل او الشيتات بالضغط مرتان علي اسم الشيت الذي تريد رؤية الاكواد المكتوبة له ستظهر لك هذه الاكواد و ممكن ايضا عن طريق الضغط علي TOOLS ثم MACRO ثم VISUAL BSIC EDITOR سيظهر لك محرر الاكواد وعند قراءتك للكود اعلاه غير ال 8 لاي عمود اخر و كذلك المدي J2 لاي خلية اخري تريد عموما جرب و اخبرني باية ملاحظات او اسئلة تحياتي عذرا قد حدث خطأغير مقصود بشرح ملف اخر و قد تم التعديل

السلام عليكم اخي جرب المرق الشرح داخل الملف و تم استخدام الكود التالي Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub Application.ScreenUpdating = False If Range("a1") = "*" Then GoTo 1 Else GoTo 2 End If 1: Application.ScreenUpdating = False Range("A2:A50").Interior.ColorIndex = 4 Application.ScreenUpdating = True Exit Sub 2: Application.ScreenUpdating = False Range("A2:A50").Interior.ColorIndex = xlNone Application.ScreenUpdating = True End Sub جرب و اخبرني النتيجة تحياتي COLUMN COLOR.rar

السلام عليكم اخي ali fathi و بعد اذن اخي يحيي اخي لو كان يوجد ملف تشرح ماتريده كان افضل عموما جرب الملف المرفق واخبرني النتيجة الشرح داخل الملف تحياتي عطلة.rar

السلام عليكم اخي طارق بارك الله فيك 10/10 و اضافه جميله من الاخ يحي 10/10 تحياتي

السلام عليكم اخي new4a بارك الله فيك تحياتي

السلام عليكم اخي abusarah73 اضافة لحل الاستاذ والاخ الحبيب خبور الحل بطريقة اخري للافاده الكود: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row < 8 Then Exit Sub If Target.Row > 80 Then Exit Sub If Target.Column < 14 Then Exit Sub If Target.Column > 22 Then Exit Sub h = Target.Value x = Target.Column L = Target.Row s = Target.Address If h <> "" Then For i = 8 To 80 If Cells(i, x).Value <> "" Then If Cells(i, x).Row <> L Then If Cells(i, x).Value = h Then Cells(i, x).Interior.ColorIndex = 4 GoTo 1 Else Target.Interior.ColorIndex = xlNone End If End If End If Next Exit Sub 1: Range(s).Select Range(s).Interior.ColorIndex = 4 End If End Sub خالص تحياتي تحديد خلايا بلون عند التشابه1.rar

السلام عليكم اخي سالم ارجو ان يكون هذا يحقق ما تريد تحياتي شهادة مدرسية 2009.rar

السلام عليكم اخي الحبيب احمد يعقوب و انت ايضا و حشنا جدا جدا و اشكرك علي كرمك بكلماتك التي لا تبخل بها ابدا و مرورك دائما يسعدني بارك الله فيك اخي الحبيب (حسن علي)new4a اشكرك اخي علي مرورك و انا ايضا اشتقت اليكم جميعا و المنتدي منور دائما بكم انتم خالص تحياتي و تقديري

السلام عليكم اخواني اعزاء mas123 سالم شباني قطان abusarah73 اشكركم جميعا علي كلماتكم التي تعوض ابتعادي عنكم و بارك الله فيكم جميعا خالص تحياتي و تقديري