نجوم المشاركات

السلام عليكم ورحمة الله وبركاته إخواني الأحباب في المنتدى الغالي هل فكرت يوماً ؟ إذاً أنت موجود .. لأن الحكمة بتقول : أنا أفكر إذاً أنا موجود ، وبتعديل بسيط ممكن نقول : أنا أؤمن بالله إذاً فالله موجود وأنا حي القلب قبل حياة الجسد سرحت اعذروني أقدم لكم اليوم كود جديد ، يقوم الكود كما هو موضح بالعنوان (والموضوع بيبان من عنوانه ..فمحدش يتوه مني عشان أنا متعمد أتوهكم) ..كما هو موضح يقوم الكود بتنفيذ الماكرو أو الإجراء الفرعي عدد معين من المرات ، يمكنك أن تحدد عدد المرات في الملف المرفق قمت بوضع عدد المرات في الخلية C3 ويمكن تغييره بالطبع ، كما يمكن أيضاً (عشان الناس متقولش إني بخلان عليكم بمعلومة) ممكن أن تغير في الكود لتضع عدد مرات التكرار الذي ترغبه داخل الكود ، وذلك من خلال تغيير هذا السطر nTimes = Range("C3").Value إلى هذا السطر nTimes = 3 إذاً فأنت حر في اختيارك لطريقة وضع قيمة المتغير المرتبط بعدد مرات التكرار وإليكم الكود بالشكل الكامل (والكمال لله وحده) 'تعريف المتغير الذي يمثل عداد لعدد مرات تنفيذ الماكرو Dim I As Integer Sub RunMacroNTimes() 'تعريف المتغير الذي يمثل عدد مرات تنفيذ الماكرو Dim nTimes As Integer 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'وضع القيمة صفر للعداد I = 0 '[C3] ليساوي قيمة الخلية [nTimes] تعيين قيمة للمتغير nTimes = Range("C3").Value 'حلقة تكرارية لتكرار تنفيذ الماكرو طبقاً لقيمة الخلية Do While I < nTimes 'زيادة قيمة العداد بمقدار واحد في كل حلقة تكرارية I = I + 1 'استدعاء الماكرو المراد تنفيذه Call Test 'الانتقال داخل الحلقة التكرارية إلى أن تساوي قيمة العداد قيمة الخلية Loop 'إظهار رسالة تفيد بعدد مرات تنفيذ الماكرو MsgBox "تم تنفيذ الماكرو " & I & " مرات" 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub Sub Test() MsgBox "مرحباً بكم إخواني .. الترحيب رقم " & I End Sub وعشان خاطر عيون حبايبي اللي زعلانين مني (وهما عارفين مين .. وكل لبيب بالإشارة يفهم .. ومش عايز حد يكون ساخـ (هـ) ـــر مني) قمت بشرح أسطر الكود للاستفادة منه في أكواد أخرى كما أقدم لكم ملف مرفق للإطلاع عليه (ودا عشان الناس الكسلانة .. شايف مختار بيحمل الملف المرفق .. لا إنت لا إنت طبقه بنفسك) وأخيراً تقبلوا تحياتي ودمتم في رعاية الله Run Macro Number Of Times YasserKhalil.rar

السلام عليكم أخوتى ورحمة الله وبركاته كلنا يعرف يشغل ماكرو لكن هل فكرت تعمل باسوورد للماكرو ؟!!!!!!!!!!!!!!!!!!!!!!!!!! ماشى البعض منا يعرف يسوق عربية - أنا مش منهم - لكن هل فكرت أنك تعمل باسوورد لعربيتك ؟!!!!!!!!!!!!!!!!! حمل المرفق وهتعرف كل شىء الكود الأساسى المستخدم بسيط : Sub passtorunmacro() Dim MyPassword MyPassword = InputBox("من فضلك أدخل كلمة سر تشغيل الماكرو ", "كلمة السر", "********") 'باسوورد الماكرو If MyPassword = "123" Then MsgBox "كلمة السر صحيحة. لتشغيل الماكرو اضغط موافق", vbInformation, "دخول" 'استدعاء الماكرو Call Shape Exit Sub Else MsgBox "كلمة السر خاطئة", vbCritical, "خطأ" Exit Sub End If End Sub وهذا هو البنزين90 عفواً أقصد الكود الفرعى الذى نستدعيه لتحريك العربية : Sub Shape() Dim i As Integer Dim j As Integer With ActiveSheet.Shapes("Picture1") For j = 1 To 10 For i = 1 To 300 .IncrementLeft 0.75 DoEvents Next i For i = 1 To 300 .IncrementLeft -0.75 DoEvents Next i Next j End With End Sub اللى تعجبه الفكرة يدعو لى أتعلم السواقة , وأشترى عربية Enter Password to run a Macro.rar

السلام عليكم ورحمة الله وبركاته إخواني الكرام .. قد يكون موضوع الكسر موضوع شائك وفيه خلاف ، ولكن ربما يكون مفيد لصاحب العمل نفسه ، حيث أنه معرض لنسيان الباسورد الذي تم وضعه على محرر الأكواد .. الموضوع مميز لأنه يقوم بكسر الحماية بدون برامج على الإطلاق ..وبدون AddIns وبدون الاستعانة بأية برامج مجانية أو مدفوعة !! كسر محرر الأكواد بالأكواد نفسها (قنبلة الموسم) وعلى رأي المثل : علمته رمي السهام فلما اشتد ساعده رماني .. الكود قليل الأصل !! محفظش الجميل للبيئة اللي هو منها ، لأنه كسر بيئة محرر الأكواد !!! Sub HackVBA() Open "C:\Users\Future\Desktop\Test.xls" For Binary As #1 Put #1, 1, Replace(Input(LOF(1), 1), "DPB=", "DPX=", , 1) Close Workbooks.Open "C:\Users\Future\Desktop\Test.xls" End Sub المطلوب فقط أن تغير مسار الملف المراد كسره داخل الكود ، والمسار يوضع بين أقواس تنصيص .. أترككم مع الفيديو عله ينال إعجابكم وتستفيدوا منه إن شاء المولى .. ولا تنسونا من اللايكات على اليوتيوب !!!!! ....أكرر اللايكات على اليوتيوب ..فضلاً لا أمراً تقبلوا تحيات أخوكم أبو البراء

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم اليوم موضوع ليس بجديد على الإطلاق ، ولكن أظن أن الكثيرين لا يعرفونه ، فأحببت أن أشارككم المعلومة علكم تستفيدون ، ولعلكم تنفضون غبار الكسل .. الذي طال أمده موضوعنا عن كيفية إضافة شريط أمر تحكم إلى الكليك يمين ، بمعنى آخر : عندك إجراء فرعي معين ، وبتستخدمه كثيراً ، ومش عايز الإجراء يكون مرتبط بزر أمر ولا يكون تلقائي ، لكن تريد أن يكون موجود في الكليك يمين .. إذاً فالحل بين يديك يتم وضع الكود التالي في حدث فتح المصنف Private Sub Workbook_open() 'هذا الحدث مرتبط بفتح المصنف 'يقوم الكود بإضافة سطر أمر إلى قائمة الكليك يمين 'تعريف متغير من النوع شريط أمر التحكم Dim NewControl As CommandBarControl On Error Resume Next 'حذف شريط الأمر من قائمة الكليك يمين إذا كان موجود من قبل Application.CommandBars("Cell").Controls("Show Date And Time").Delete On Error GoTo 0 'إنشاء أو إضافة شريط أمر التحكم Set NewControl = Application.CommandBars("Cell").Controls.Add With NewControl 'عنوان شريط أمر التحكم الذي سيظهر في قائمة الكليك يمين .Caption = "Show Date and Time" 'مسار واسم الإجراء الفرعي المرتبط بشريط أمر التحكم .OnAction = "Module1.DateAndTime" 'عدم فصل شريط أمر التحكم الجديد بخط .BeginGroup = False End With End Sub وحتى لا تحدث أخطاء في برنامج الإكسيل يراعى أن يتم حذف شريط أمر التحكم الذي تمت إضافته ولذا ستجد الكود التالي في حدث إغلاق المصنف Sub Workbook_BeforeClose(Cancel As Boolean) 'هذا الحدث مرتبط بإغلاق المصنف On Error Resume Next 'هذا السطر لحذف الأمر - الذي تمت إضافته عند فتح المصنف - من قائمة الكليك يمين Application.CommandBars("Cell").Controls("Show Date and Time").Delete End Sub وهذا هو الكود المرتبط تنفيذه بشريط أمر التحكم Sub DateAndTime() 'هذا هو الماكرو الذي تمت إضافته لقائمة الكليك يمين MsgBox "Today is: " & Format(Date, "dd. mm. yyyy") & "." & vbCr & vbCr & "It is: " & Format(Time, "hh:mm:ss") End Sub وأخيراً تقبلوا تحيات أخوكم أبو البراء دمتم على طاعة الله Add Control To Right Click Menu.rar

السلام عليكم اولا هذه الملفات ليست لى بل هى من ابداع الاستاتذه الكبار فى هذا الصرح الكبير وصرح اخر كبير اتمنى من الله ان يعود الينا وهوا الفريق العربي للبرمجه ومجموعه كبيرة من المواقع وهى موجوده بمكتبتى واحببت ان اضغها هناا ليستفيد منها طلاب العلم مثلى ولخوفى عليها من الضياع ____________________ مع خالص شكرى وتقديرى الى الاساتذة الكبار اصحاب هذه الامثله جعلها الله فى ميزان حسناتهم يوم القيامة ( اللهم بارك لهم فى علمهم وفى رزقهم وفى اهلهم يا اكرم الاكرمين يا الله ) تسعة أمثله للبحث منها مثال للبحث بطريقتين لأبو هاجر.rar مثال من تصميم أحد الأخوة فيه عدة أمثلة على نماذج و تقارير مختلفة.rar FileSize-مثال مهم جدا يعرض لك حجم المكونات الفعلية للبيانات.rar ربط قاعدة البيانات حسب الاختيار (المثال بعد التعديل).rar ChooseReportFromList2_2k-مثال على كيفية اختيار اسم التقرير المطلوب من لائحة ListBox.rar مثل الصلاحيات.rar CtlGroups-مثال للتحكم بخصائص مربعات النص من خلال أزرار الاختيار ف يالنموذج.rar sHIFT-مثال للتحكم في خصائص تشغيل أي ملف أخر , مثل السماح باظهار صفحة بيانات الملف أو استخدام المفاتيح الرئيسية او اظهار شريط الأدوات أو ... الخ.rar Tree- مثال على البنية الشجرية - تصميم أبو هادي - أوفسينا.rar findrecord2k--مثال مفيد جدا لمن يحتاج المساعدة في بناء الاستعلامات بسهولة كبيرة.rar Animation2k-مثال رائع على استخدام خاصية المؤقت في النموذج Timer لصنع ساعة - أشكال متحركة مختلفة.rar Atomatic_Record_Scrolling-مثال يجعل النموذج ينتقل تلقائيا من سجل للسجل الذي يليه - استخدام المؤقت في النموذج.rar AutoBkUp2K-- مثال لعمل نسخ احتياطي تلقائي لقاعدة البيانات.rar UpdateDirect2k - مثال على الاستيراد و التصدير المبرمج.rar

أخوتى فى الله السلام عليكم كلنا يعلم أن الفلترة شىء هام فى الاكسل كثيراً ما نحتاجه وكلنا نعلم أن الفلترة تكون حسب اعتبارات كثيرة لكن كونها تكون حسب لون الخط أعتقد أن القليل منا يعرفها لذلك أحببتُ أن أشاركم بهذا الكود المنقول لرجل أقدره فى هذا المجال وهو Ron de Bruin بدون إطالة تفضلوا المرفق وتقبلوا تحياتى Filtering by the Active Cell's Font Color.rar

أخى صلاح الدين الأيوبى وأخى زيزو البسكرى بارك الله فيكما تعرفوا أنا بدأت فى الاكسل بشوية معلومات قشور ولجأت الى أوفيسنا سائلأ مش مجيباً الاكسل بحر ما له قرار ولكن مع شوية تعب هنا وهناك لحد ما أصبح لدىً قدر معقول من مهارات الاكسل والحمد لله فعليكما بالبحث وتجميع الأفكار هذه الأفكار تنصهر وتطلع أفكار جديدة فأنت لا تتعجب ولا تحتار امشى على طريقة أخوك مختار أخى زيزو البسكرى لو بصيت فى المرفق وفتحت الفيجوال بيسك هتلاقى الأكواد فى مديول عادى مش فى حدث المصنف ولا فى حدث الورقة تحياتى

ههههه والله معك حق سيّدي الفاضل صلاح الدين الأيوبي ..أركب ألف عربية و لا أركب نصف كود . كود مميّز أستاذي مختار حسين محمود بارك الله فيك و جزاك الله خيرًا..فقط سؤالي كمبتديء أين نضع هذيْن الكوديْن لو سمحت ؟؟

الأصل ألا يأخذ الطالب صفرا والغياب لا يتم تمريره للدالة مباشرة حيث أن الرقم الذي يتم تمريره للدالة من نوع double لذا يجب تحويل الغياب إلى رقم سالب أولا ................ تم التعديل في المرفق تفقيط الدرجات.rar

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

اخى الكريم اولا قم بعمل تكست بوكس جديد وبالتالى سوف يكون رقمه 3 ثم قم باستبدال هذا السطر بالكود ( هتلاقية بزر التاكيد) If TextBox1 = "12345" Then Unload Me: Exit Sub بهذا السطر If TextBox1 = "12345" And TextBox3 = "عبدالعزيز" Then Unload Me: Exit Sub جرب وعلمنى بالنتيجة انا محبتش ارفق الملف بالحل انا عايزك انت تجرب بنفسك تقبل تحياتى

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

اخواني الاعزاء وانا ابحث في مواقع الاجنبية و العربية وجدت هذا الفايل الاكسل الذي فيه خمس شيت و صاحب الفايل بذل فيه جهد كبير تصفحوه واستفيدو من فكرته القوية جدا في الاكسل لاني من عشاق الفنون الاكسل home balancesheel.rar

تفضل 1. التوقيت: البرنامج يفحص وقت الكمبيوتر كل دقيقة ، 2. هذا هو كود الفحص: Private Sub Form_Timer() Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC 'Debug.Print Format(Now, "hh:mm") & vbCrLf & Format(rst!Class_Time_From, "hh:mm") & vbCrLf & Format(rst!Class_Time_To, "hh:mm") & vbCrLf 'compare the timer with the Class_Time If Format(Now, "hh:mm") >= Format(rst!Class_Time_From, "hh:mm") And Format(Now, "hh:mm") <= Format(rst!Class_Time_To, "hh:mm") Then 'Debug.Print "I am in" rst.FindFirst "[Class_Number]=" & rst!Class_Number Me.Bookmark = rst.Bookmark Exit Sub End If rst.MoveNext Next i Debug.Print "------" End Sub 3. اضفت 3 حقول في الجدول: Class_Number: لرقم كل حصة ، ومافي داعي لها ، لكنها لتسهيل الشغل (يعني بالعربي ، انا حطيتها ، وبعدين شفت مافي داعي لها ، بس كنت كتبت الكود ومستكاود اغيره ) ، Class_Time_From: البرنامج يفحص الوقت "من" و "الى" ، وحسب التجربة ، يفضل ان يكون الوقت بينهم على الاقل 3 دقائق ، Class_Time_To: جعفر 60.تجريبي.mdb.zip

السلام عليكم ورحمة الله وبركاته مرفق ثلاث ملفات اثنان للترقيم التلقائي بالأكواد وواحد بالمعادلات بمجرد الكتابة في الخلية B يتم نزول الترقيم تلقائي كود ترقيم تلقائي 3.rar ترقيم تلقائي 4.rar ترقيم تلقائي بالمعادلة.rar

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

إخواني الأعزاء وأساتذتي، اقترح عليكم الآتي بعد إذنكم وسعة صدركم وهذا على قدر علمي واعتقادي بأن هذا ممكن: يتم عرض الموضوع كاملا ولا يسمح بمناقشته مع الزملاء إلا بعد انتهاء الشرح، لأن المقاطعة تشتت القارئ وتشغل الشارح ويتسبب ذلك في ضعف الأمثلة المقدمة ووجود بعض الثغرات بها ونحن نريد أن يكون مريدي هذا الموقع من أساتذة البرمجة في مصر. أحبتي هذا ليس تطاول ولا تصيد أحطاء وإنما هي غيرة ومحبة لجميع الشارحين بالمنتدى وفقكم الله للخير دائما.

أولا مرحبا بك أخى العزيز فى منتدانا والصرح العلمى الكبير الذى ننهل منه جميعا ثانيا فالعلم لا يقتصر فقط على قراءة الكتب بل هو بحاجة الى التطبيق العملى وهذا الصرح ذاخر بالعديد والكثير الكثير من اﻷمثلة الصغيرة بل والبرامج الكبيرة الحجم وللقدر العلمى بكبر قدر أصحابها فهذه نصيجتى لك خذ من هذه اﻷمثلة الصغيرة مايكفيك وجرب ونفذ بنفسك فهذه خطوة نحو الاحتراف وأخيرا أهلا وسهلا ومرحبا بك

رحم الله والديك و زادك في علمك و نفعك و نفعنا به هذا بالتحديد ما ابحث عنه

الاخ الحبيب حسام عيسى بارك الله فيك الأخ صلاح الصغير هذا رابط للموضوع ، الفكرة تقوم على أساس الحفظ كل فترة تقوم بتحديدها كل 10 ثواني ..كل دقيقة ..زي ما تحب http://www.officena.net/ib/index.php?showtopic=56802&hl= وبعدين هي جات ع الكهربا وبس ..دا الكهربا وشوية الغاز وشوية المية المفسفتة .. بكرة تشوفوا مصر واشرب فوسفات وانسى اللي فات تقبل تحياتي

على فكرة يا أبوصلاح أخوك مش ناسيك كنت فى بالى وأنا مريح من عناء الاكسل النهردة الصبحية كوداية صغيرة فى حدث المصنف زى دى Private Sub Workbook_Open() AlertTime = Now + TimeValue("00:00:10") Application.OnTime AlertTime, "autosave" End Sub وحنة صغيرة فى مديول عادى زى دى Sub autosave() Application.ScreenUpdating = False Application.DisplayAlerts = False ThisWorkbook.Save AlertTime = Now + TimeValue("00:00:10") Application.OnTime AlertTime, "autosave" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub الأثنين بيعملو حفظ تلقائى كل 10 ثوانى من غير ما تشعر تحياتى

جزيت خيرا وزوجت بكرا..

استاذي ياسر خليل نحن نتعلم منكم فانت من خير اساتذة المنتدى

جزاك الله خيرا وجعله الله فى موازين حسناتكم

اخى احبيب الاستاذ صلاح الموضوع مش معقد يمكنك ذالك بكل سهوله ضع هذا الكود فى اى مودويل والموضوع يخص الاستاذ ياسر خليل حاولت البحث عن الموضوع الاصلى وللاسف لم اصل الي الرابط الخاص بالموضوع ولكن هذا هو الكود Public RunWhen As Double Public Const cRunIntervalSeconds = 10 Public Const cRunWhat = "The_Sub" Sub StartTimer() RunWhen = Now + TimeSerial(0, 2, 0) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _ schedule:=True End Sub Sub The_Sub() ActiveWorkbook.Save StartTimer End Sub Sub StopTimer() On Error Resume Next Application.OnTime earliesttime:=RunWhen, _ procedure:=cRunWhat, schedule:=False End Sub ثم ضع فى حدث فتح الملف هذا الكود Private Sub Workbook_Open() StartTimer End Sub ثم ضع هذا بحدث قبل اغلاق الملف Private Sub Workbook_BeforeClose(Cancel As Boolean) StopTimer End Sub يمكن من هذا السطر بالكود -- تحديد الوقت بين كل عمليه حفظ واخرى ( هو حاليا كل دقيقتين يقوم الجهاز بالحفظ التلقائى ) RunWhen = Now + TimeSerial(0, 2, 0) تقبل تحياتى

يارب تتعلم السواقة , وتشترى عربية ... هههه مع ان السواقه اسهل من الكود

بارك الله فيك أستاذي الغالي "مختار حسين محمود" ..جزاك الله خيرًا و زادها بميزان حسناتك ..وزادك من علمه و فضله ..ألف تحية شكر و تقدير واحترام لمساعدتك القيّمة لي ..و أقدّم إعتذاري لك للمرّة المليون لعدم إختيار مساعدتك كأفضل إجابة لأنّها تستحق أيضا ذلك فكلتا إجابتيْكما و الأستاذ الفاضل الصقر تستحقان فعلاً أفضل إجابة ..بارك الله فيكما و لكما دنيا و آخرة

أخى طبعاً يمكن ذلك بكل تأكيد ولكن بعد عودة الكهرباء بالسلامة :jump: بهذر معاك يا أبوصلاح

استاذى الحبيب ابراهيم ابوليله الذى طالما استفدت منه وساعدتنى فى الاكسيل وخصوصا فى vba سعادتى كبيره بوجودك فى موضوعاتى بارك الله فيك وجزاكم الله خير تقبل منى تحياتى وتقديرى

الأخ الفاضل محمد أبو العلا صراحة مبقتش عارف ايه المطلوب قدمت لك حل بالمعادلات .. وحل بالاكواد !! بالنسبة للقائمة المنسدلة روح للخلية اللي فيها القائمة المنسدلة وبعدين روح للتبويب Data ثم Data Validation ثم ستجد في النافذة الأمر Clear All وبذلك تتخلص من القائمة المنسدلة ويمكنك استخدام الخلية لكتابة أي رقم لأي عملية ..

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

اخي الفاضل انا عملت ملف بس مش عارف هو ده اللي انت تقصده ولا لا ممكن تشوفه وتقول رأيك توزيع الخلايا.rar

بسم الله ما شاء الله ولا حول ولا قوة الا بالله جازاكم الله خيرا أراك اليومين الأخيرين شعلة نشاط اللهم لا حسد ولكن غبطة حتى شوف :wink2: ألف مبروك على المشاركة 5000 عقبال المليون

تفضل اخى الحبيب المرفق يعطى اشارة الليبل مثل اشارات المرور تقبل تحياتى المحاولات.zip

بارك الله فيك و جزاك الله خيرا..تم عمل المطلوب بشكل سليم و صحيح ..ألف شكر أستاذي

بُوركت وجازاكم الله خيراً أخى عبدو

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

تفضل أخى عبدووووووووو recharche XD 1 v2.rar recharche XD 2 v2.rar

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

أستاذ قيس بارك الله فيكم وتقبلّ دعاءكم أستاذى الفاضل محمد صالح ما كنت أدرى أن الكود خاص بكم الا الآن وإلا كنت أشرت أنه لك وفعلا أنا وجدته فى أحد كنترولات المدارس واحتفظت به عند الحاجة فقد أعجبنى الكود وخاصة أنه يفقط الدرجة و نصف الدرجة أما عن التعديل فأقترح على حضرتكم اضافة 0 فقد يحصل طالب على الصفر غـ فقد نجد طالب غائب فى مادة تعديل تفقيط الــ 1/2 يكتب فقط درجة ونصف والأصل فقط نصف درجة . تقبل تحياتى

الأخ الفاضل الساهر ----------------- إليك الكود التالي في حدث ورقة العمل لعله يكون المطلوب Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Long LR = Cells(Rows.Count, 2).End(xlUp).Row If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B6:C6")) Is Nothing Then With ActiveSheet .AutoFilterMode = False With .Range("B8:C" & LR) .AutoFilter Field:=1, Criteria1:=">=" & Range("B6").Value, Operator:=xlAnd .AutoFilter Field:=2, Criteria1:=">=" & Range("C6").Value, Operator:=xlAnd End With End With End If End Sub وأخيراً لا تنسى أن تحدد الإجابة كأفضل إجابة في حالة أن تم حل المسألة تقبل تحياتي :fff: AutoFilter Automatically YasserKhalil.rar

الأخ الفاضل يرجى تغيير اسمك للغة العربية لسهولة التواصل جرب الملف التالي تم عمل قائمة منسدلة اختار منها رقم العملية سيتم نقلك إليها وعند الانتقال للورقة الأخرى يمكنك الرجوع إلى الورقة الرئيسية بمجرد النقر المزدوج داخل أي خلية في العمود G دا الكود الأول في حدث ورقة العمل الأولى Private Sub Worksheet_Change(ByVal Target As Range) Dim X As Long If Target.Cells.CountLarge > 1 Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("H3")) Is Nothing Then Sheet2.Activate X = Application.WorksheetFunction.Match(Sheet1.Range("H3").Value, Sheet2.Columns("G:G"), 0) Sheet2.Cells(X, "G").Select End If End Sub ودا الكود الثاني في حدث ورقة العمل الثانية Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Columns("G:G")) Is Nothing Then Sheet1.Activate End If End Sub تقبل تحياتي ولا تنسى التوجيهات (حدد أفضل إجابة ليظهر الموضوع منتهي ومجاب) Hyperlink Formula YasserKhalil V2.rar

السلام عليكم استاذي الفاضل رمهان ورحمة الله وبركاته لايسعني الا ان اقدم شكري الجزيل لك وكلمة الشكر قليلة في حقك لكن لك مني هذا الدعاء بظهر الغيب الله لايحرمنا من شخصك الكريم والطيب سائلا الله عز وعلا ان يمن عليك وعلى عائلتك الكريمة بالصحة والعافية يارب

انسخ هذا الكود وصعه في حدث الصفحة: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range For Each rng In Target.Cells If rng.HasFormula Then ActiveSheet.Protect Exit Sub Else ActiveSheet.Unprotect End If Next rng End Sub

عزيزي علي فتحي وبعد اذن الاستاذ جعفر على المداخلة محاولة لحفظ جزء من وقته ! وكذلك اخي راعي الغنم استأذنه ولعل له به فائدة ! اعمل استعلام ومصدره الجملة التالية واحفظه باسم qr1 : SELECT Record_OLD.[رقم تعريفي], Record_OLD.الاسم, Max(Record_OLD.فرعي) AS Maxمنفرعي, Max((IIf([رصيد 1]<0,0,[رصيد 1])+IIf([رصيد 2]<0,0,[رصيد 2]))/2) AS expr1 FROM Record_OLD GROUP BY Record_OLD.[رقم تعريفي], Record_OLD.الاسم; واستعلام ثاني ومصدره الجملة التالية واحفظه باسم qr2 : SELECT Record_OLD.[رقم تعريفي], Record_OLD.الاسم, Record_OLD.فرعي, Record_OLD.[رصيد 1], Record_OLD.[رصيد 2], (IIf([رصيد 1]<0,0,[رصيد 1])+IIf([رصيد 2]<0,0,[رصيد 2]))/2 AS المتوسط FROM Record_OLD; واستعلام ثالث واحفظه باسم qr3 حيث هو المطلوب : SELECT [qr2].[رقم تعريفي], [qr2].الاسم, [qr2].فرعي, [qr2].[رصيد 1], [qr2].[رصيد 2], qr2.[المتوسط] FROM qr2 INNER JOIN qr1 ON (qr2.[المتوسط]=qr1.expr1) AND ([qr2].فرعي=[qr1].Maxمنفرعي) AND ([qr2].الاسم=[qr1].الاسم) AND ([qr2].[رقم تعريفي]=[qr1].[رقم تعريفي]); هذا متمنيا ان يكون المطلوب !! تحياتي

الدخول ب3 محاولات.وادا كانت لمحاولة ثالثة خطأ يغلق الملف نهائي Private Sub CommandButton1_Click() Static compteur As Byte compteur = compteur + 1 If TextBox1.Value = Sheet1.[A1].Text And TextBox2.Value = Sheet1.[A2].Text Then Unload Me Else If compteur = 3 Then MsgBox "خطاء في كتابةكلمةالسر." & _ vbCrLf & "لايمكنك الدخول للبرنامج" & _ vbCrLf & vbCrLf & "سوف تغادر....", _ vbOKOnly + vbCritical, "كلمةالسر خاطئة" ActiveWorkbook.Close End If MsgBox "كلمةالسرغيرصحيحة." & _ vbCrLf & "ليس لديك الصلاحية للدخول", _ vbOKOnly + vbExclamation, "كلمةالسرخاظئة" TextBox1.Value = "" TextBox2.Value = "" TextBox1.SetFocus Me.Caption = "Entrez le mot de passe. Tentative " & _ compteur + 1 & " sur 3" i = i + 1 If i = 2 Then End End If End If End Sub

الملف بين يديك اضغط اجبني في حال كان كذلك حسومات.rar

يا رب يكون آخر طلب أخي صلاح .. بهزر معاك طبعاً ..اطلب براحتك بس يا ريت ميكونش كله في موضوع واحد ! Sub Tarhil() 'تعريف المتغيرات Dim WS As Worksheet, SH As Worksheet Dim strCrt As String Dim I As Long, X As Long 'بحيث يساوي رقم 6 وهذا الرقم يمثل أول صف سيتم الترحيل إليه [X] تعيين قيمة للمتغير X = 6 'تعيين أوراق العمل : ورقة العمل المراد الترحيل منها وورقة العمل المراد الترحيل إليها Set WS = RawData: Set SH = ClientSheet 'في ورقة العمل المسماة كشف حساب العميل [T1] وهو الشرط المراد العمل على أساسه في عملية الترحيل ، وقد تم دمج الشروط في خلية واحدة فقط وهي الخلية [strCrt] تعيين قيمة للمتغير strCrt = SH.Range("T1").Value 'الغاء خاصية اهتزاز الشاشة لتسريع عمل الكود Application.ScreenUpdating = False 'مسح محتويات النطاق المراد الترحيل إليه SH.Range("A6:R135").ClearContents '[RawData]بدء التعامل مع ورقة العمل المسماة With WS 'حلقة تكرارية من الصف رقم 6 إلى آخر خلية بها بيانات في ورقة العمل المراد الترحيل منها For I = 6 To .Cells(4000, 1).End(xlUp).Row ' تساوي الشرط أم لا [S] جملة شرطية لمعرفة إذا ما كانت الخلية الموجودة في الصف في العمود If .Cells(I, "S").Value = strCrt Then '[R] إلى العمود [A] إذا تحقق الشرط يقوم هذا السطر بنسخ السطر بداية من العمود .Range(.Cells(I, "A"), .Cells(I, "R")).Copy 'كبداية عملية اللصق [A6] لصق الصف الذي تم نسخه كقيم فقط إلى الخلية SH.Range("A" & X).PasteSpecial xlPasteValues 'زيادة قيمة المتغير بمقدار واحد استعداداً للصق صف جديد إذا تحقق الشرط X = X + 1 'نهاية الشرط End If 'الانتقال إلى صف جديد في الحلقة التكرارية Next I 'إنهاء التعامل مع ورقة العمل المراد الترحيل منها End With 'الغاء خاصية النسخ والقص Application.CutCopyMode = False 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub تقبل تحياتي

جرب المرفق التالي .. كشف حساب جديد.rar

قائمة منسدلة متعددة الألوان - اختار لون الخلفية و الحروف لكل عنصر في القائمة هو موضوع وجدته في منتدي صديق ( منتدي القدير / يحيي حسين ) للعلامة القدير / Jaafar Tribak المغربي واردت ان اضعه بين ايديكم كما هو وكما هو وضعه بالضبط وبالطبع استئذنه في ذلك ولعلمي انه شديد الحرص علي اعطاء كل معلومه لديه للآخرين فلم اتردد لحظة في نقل الموضوع الي منتدانا العملاق ليستفيد منه الجميع وسأضع الموضوع كما وضعه هو حرفيا جعله الله في ميزان حسناته ==================================================== المــــــــــــــــــوضـــــــــــــــوع ( كما هو ) ==================================================== طلب نجده كثيرا عند مستخدمي الاكسل لكن لا يوجد حل - الحمد لله هذا ما توصلت اليه مؤخرا فأرجو أن يكون مفيدا. من أراد استفسارا لكيفية عمل الكود أو وجد أي مشكلة في تشغيله فأنا ان شاء الله أكون رهن الاشارة Multicolor_Combobox.rar