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

بسم الله الرحمن الرحيم Formula To VBA ضع الماوس على الخلية التي يوجد فيها معادلة معينة وإضغط على بسم الله ستظهر لديك المعادلة محولة و جاهزة للنسخ , قم بنسخها ثم قم بوضعها داخل كود أخونا الكريم عبد الله باقشير جزاه الله خيرا . الطريقة و الكود في المرفقات لكم مني أطيب التحيات محول المعادلات السريع.rar

السلام عليكم الاخ الحبيب / إبراهيم ابوليله بارك الله فيك وبعد اذن اخي الفاضل / وليد فتحي ... جزاه الله خيرا والذي يسير في طريقه الي التميز ومساعدة الجميع تقبل الله منا ومنكم .. ووفقكم الله جرب هذه المحاوله مني علي حسب فهمي لطلبك ... واستخدم الكود التالي ضع رقم الصفحة الذي تريد الطباعه اليها في الفورم .. ثن اضغط زر طباعة Private Sub CommandButton1_Click() ActiveWindow.SelectedSheets.PrintOut From:=1, To:=TextBox1.Value, _ Copies:=1, Collate:=True End End Sub تقبلوا خالص تحياتي طباعة صفحات.rar

السلام عليكم الاخ الحبيب / محمود الاسيوطى بارك الله فيك ضع الكود التالي في حدث الشيت Entry بالشكل التالي ليجعل الزر نشط او غير نشط لتنفيذ عملية الترحيل Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("f14").Value = "يمكنك الترحيل" Then CommandButton1.Enabled = True ElseIf Range("f14").Value = "لا يمكنك الترحيل" Or Range("f14").Value = "ادخل بياناتك" Then CommandButton1.Enabled = False End If End Sub وقم بوضع الكود التالي في حدث زر الترحيل Private Sub CommandButton1_Click() Dim ws, ws1 As Worksheet Dim LR, LR1 As Long Dim iRow As Long Set ws = Worksheets("Database") Set ws1 = Worksheets("Entry") LR = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row ws.Cells(LR, 4).Value = ws1.[d14].Value ws.Cells(LR, 5).Value = ws1.[d15].Value ws.Cells(LR, 6).Value = ws1.[d16].Value ws1.Range("C20:F40").Copy ws.Select LR1 = ws.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row ws.Cells(LR1, 7).Select ws.Paste ws.[d3].Select MsgBox "الحمد لله... تم ترحيل القيد بنجاح" ws1.Select Range("C18").Select Application.CutCopyMode = False End Sub تقبل خالص تحياتي مثال على الترحيل-SAMA.rar

السلام عليكم الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩ بارك الله فيك بالنسبة للشرح واين الخطأ ... انت تريد في الكود الخاص بك ان تقوم بمسح محتويات نطاقات معينة وهي Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents وفي نفس الوقت تقوم بحماية الشيتات من التعديلات ... فبالتالي عند تنفيذ الكود لعملية المسح .. سيتوقف ... حيث ان الشيت المحدد او الشيتات المحددة لعمل الكود محمية من التعديل وبالنسبة للكود ( السطر ) المستخدم منكم او من الاخ الفاضل / وليد فتحي فهو صحيح ولكن يخص الشيت النشط فقط ... فمثلا في الملف المرفق في مشاركتي يتم تشغيل المود من خلال شيت ( عام ) وبالتالي سيتم ازاله الحماية عن هذا الشيت النشط فقط وبالتالي تظهر معك الرسالة الخاصة بمسح المحتويات المطلوبة في الشيتات المحددة .. حيث انه لم يتم ازاله الحماية عنها لتنفيذ الكود ومسح البيانات الرسالة : يظهر run-time error 1004 ولذلك فقمت في التعديل علي الكود بالتالي واولا اليك الصورة التي يتم الشرح علي اساسها للجزءين المضافين اضافة الجزء التالي علي الكود وذلك حتي يتم اولا ازاله الحماية من علي الشيتات المحددة في بداية تنفيذ الكود بالجزء التالي وهي هنا في الشكل السابق اعتبارا من الشيت رقم 2 وحتي آخر شيت السطر التالي يقوم بامر الكود بالاكمال حتي في حاله وجود خطأ On Error Resume Next السطر التالي يتم وضع متغير اسمه i يكون اعتبارا من الشيت رقم 2 كما في الصورة التاليه حتي آخر شيت في الملف ( يقوم بعد الشيتات من 2 الي النهاية ) For i = 2 To Sheets.Count ثم نأمر الكود باختيار الشيت i وهو هنا كما قلنا الاختيار من الشيت رقم 2 الي النهاية وهو هنا في مثالنا يبدأ بعد الشيت ( عام ) ليشمل الشيتات (الاتوبيس - طائرة - مطروح - تعديل ) Sheets(i).Select السطر التالي يقوم بازالة الحماية عن الشيت النشط والذي تم حمايته بالرقم السري 1 والشيت النشط هنا هو الشيت i في كل مرة يقوم الكود باختيار شيت معين من الشيتات i ActiveSheet.Unprotect ("1") انهاء جمله for Next i ثم اعادته الحماية مرة اخري في نهاية الكود بالجزء التالي من الكود On Error Resume Next For i = 2 To Sheets.Count Sheets(i).Select Sheets(i).Select ActiveSheet.Protect ("1") Next i وهو نفس شرح الجزء السابق فيما عد الجزء الخاص ActiveSheet.Protect حيث يكون Protect وليس Unprotect لاعادة الحماية علي الشيتات i المحددة في الكود ارجو ان اكون قد وفقت في شرح المعلومة تقبل خالص تحياتي

السلام عليكم الاخ الكريم / ۩◊۩ أبو حنين ۩◊۩ بارك الله فيك بعد اذن اخي الفاضل / وليد فتحي ... جزاه الله خيرا استخدم التعديل التالي علي الكود الخاص بك لتنفيذ طلبك Sub delete_datas() Application.ScreenUpdating = False sama = MsgBox("سيتم حذف بيانات الشيتات الأربعة (الاتوبيس-طائرة-مطروح-تعديل)... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo) If sama = vbYes Then '============================= On Error Resume Next For i = 2 To Sheets.Count Sheets(i).Select ActiveSheet.Unprotect ("1") Next i '============================= For Each Sh In Worksheets If Sh.Name Like "تعديل" Or Sh.Name Like "الاتوبيس" _ Or Sh.Name Like "مطروح" Or Sh.Name Like "طائرة" _ Then Sh.Select: Range("B5:B40" & ",H5:H40" & ",J5:J40" & ",O5:O40").ClearContents Next Else MsgBox "!! لم يتم التفريغ" End If '============================= On Error Resume Next For i = 2 To Sheets.Count Sheets(i).Select Sheets(i).Select ActiveSheet.Protect ("1") Next i '============================= Application.ScreenUpdating = True Sheets("عام").Select End Sub وان شاء الله سينفع معك او قم بوضع ملف كمثال للعمل عليه تقبل خالص تحياتي وجرب علي المرفقات تنفيذ كود مسح بيانات من شيتات مع حماية هذه الشيتات.rar

شيت المرتب معدل حسب حافز الاعباء الوظيفية للمعلم وحسب زيادة تاحد الادني الملف مرفق ارجو ان ينال الاعجاب لمن يريد تعديل الشيت الباسورد الخاص بالشيت khnr7khnr7المرتب والمكافئة النهائي.rar

اخى الجموعى تفضل تم عمل المطلوب الاول اما بالنسبه للمطلوب الثانى والخاص بزر ادخال البياناتفاذا تريد بالتحديد نموذج لشهادة مدرسية+طباعة.rar

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

ماشاء الله عليك اخي ابو حنين جزاك الله كل خير وزادك من علمه تقبل مروري

اخى محمود تم تعديل الكود جرب واعلمنى تحياتى Sub saad() Application.ScreenUpdating = False Sheets("Entry").Select al = Sheets("Database").[e10000].End(xlUp).Row If [d1] = "" Or [d2] = "" Or [d3] = "" Then MsgBox "Ãßãá ÇáÈíÇäÇÊ ÃæáÇ" Exit Sub ElseIf Not [c4].Value = [d4].Value Then MsgBox "!ÊÃßÏ ãä ÅÏÎÇá ÇáÞíÏ ãÚ ÊæÇÒä ÇáØÑÝíä", vbExclamation, "ÅÏÎÇá ÎÇØÆ" Exit Sub ElseIf Sheets("Database").Range("e" & al).Value = [d2].Value Then MsgBox "!ÊÃßÏ ãä ÚÏã ÊßÑÇÑ ÇáÝíÏ", vbExclamation, "ÅÏÎÇá ÎÇØÆ" Exit Sub 'Else End If For r = 7 To Sheets("Entry").[c3000].End(xlUp).Row With Sheets("Database").[d10000].End(xlUp) .Offset(1, 0) = Sheets("Entry").[d1].Value .Offset(1, 1) = Sheets("Entry").[d2].Value .Offset(1, 2) = Sheets("Entry").[d3].Value .Offset(1, 3) = Sheets("Entry").Cells(r, 3) .Offset(1, 4) = Sheets("Entry").Cells(r, 4) .Offset(1, 5) = Sheets("Entry").Cells(r, 5) .Offset(1, 6) = Sheets("Entry").Cells(r, 6) End With Next r Application.ScreenUpdating = True End Sub مثال على الترحيل.rar

اخى جرب المرفق لعله المطلوب حذف محتوى خلاي في الصفوف.rar

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

اخي عبد الرحمن جزاك الله خيرا

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

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

تم فصل هذه المشاركات من الموضوع الاساسي بعنوان عمل إخفاء للحقول التي قيمتها صفر أوتماتيكيا الي هذا العنوان حيث انه تم تقديم طلب آخر لا يخص العنوان برجاء مراعاه ذلك فيما بعد ×××××××××××××××× الادارة ××××××××××××××××

بارك الله فيك وجزى الله خيرا لأستاذنا / عبد الله باقشير

السلام عليكم جزاك الله خيرا اخى العزيز وجزا الله اخونا عبد الله باقشير على ما تقدموه للمنتدى من كل جديد

ضع هذا السطر في زر الامر الموجود في الملف Rows("4:40").Delete Shift:=xlUp

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

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

الله ينور على حضرتك أقترح إنه يشغل الباتش فى وضعية الأدمنستراتور يعنى يضغط على الباتش بيمين الماوس و يشغله أدمنستراتور

بعد إذن أخى الحبيب / جمال عبد السميع :fff: هذا كود لترحيل البيانات التى يتم ادخالها مع مرعاة عدم ترحيل البيانات المكررة ومسح البيانات المرحلة من الصفحة الأصلية بعد عملية الترحيل Sub ragab() Set WF = Application.WorksheetFunction Application.ScreenUpdating = False If IsEmpty([B6]) Or IsEmpty([B8]) Or IsEmpty([B9]) Or IsEmpty([B10]) Then MsgBox "أكمل البيانات أولا" Exit Sub End If On Error Resume Next x = Trim(Range("B6").Value) LR = Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1 If WF.CountIf(Sheets(x).Range(Sheets(x).Cells(3, 1), Sheets(x).Cells(LR, 1)), [B8]) >= 1 Then MsgBox "هذا الإسم مكرر حيث تم ترحيله من قبل" Exit Sub End If Sheets(x).Cells(LR, 1).Resize(1, 3).Value = WF.Transpose(Range("B8:B10").Value) Range("B8:B10").Value = "" MsgBox "تم الترحيل بحمد الله" [B6].Select Application.ScreenUpdating = True End Sub ترحيل إلى عدة صفحات.rar

أتفضل أخي أبو حنين معادلة أخري لعد الخلايا التي بها قيم Book_22.rar

الأستاذ / أبو حنين السلام عليكم ورحمة الله وبركاته بعد إذن استاذنا الكبير / عبد الله المجرب جزاه الله خيراً إليك الملف به المطلوب. Book1.rar

السلام عليكم ورحمة الله وبركاته اتفضل اخي الحبيب استخدمت معادلة أخونا الفاضل أبو عبدالله بالاضافة لكود الاخفاء والاظهار Book_11.rar

السلام عليكم استعمل هذه المعادلة في الخلية A3 واسحب اسفل =IF(OR(C3<=0;C3="");"";SUBTOTAL(3;$C$3:C3)-COUNTIF($C$3:$C3;0))

تفضل أخى ترحيل بيانات 2.rar

الأخ الكريم/ krimo145 السلام عليكم ورحمة الله وبركاته وبعد إستئذان الأخ الكريم/ محمد الشابورى صاحب المشاركات القوية جرب عمل الخطوات التالية - كمحاولات لحل المشكلة : 1- عند تسجيل المكتبة بالأمر Regsvr32.exe fm20.dll يجب تكون لك صلاحيات مسئول النظام Administrator 2- هل حدث الأمر فجأة ؟ بمعني لم تظهر الرسالة من قبل وبدأت تظهر حديثا - إن كان الوضع كذلك قم بعمل System Restore لإعادة الويندوز إلي حالته الأولي - حيث في بعض الحالات يكون الخطأ مرتبط بالريجستري 3- إذا كان الويندوز XP تأكد من تثبيت Service Pack 3 4- أعد نسخ الملف fm20.dll من السي دي وقم بتسجيله مرة أخري - لربما كان معطوبا . 5- تثبيت نسخة جديدة من برنامج الأوفيس هذا ما يحضرني الآن - بالتوفيق - تقبل تحياتي

أخى الفاضل / أرجو الإنتباه الى قواعد المشاركة فى المنتدى قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.

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

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

أخى الحبيب ( محمد نت ) وبعد إذن أخى الحبيب ( حمادة باشا ) وأعذرنى لم أستطع فتح مرفقك لأن على جهازى أوفيس 2003 وعلى العموم زيادة فى الخير أنظر أخى لهذا المرفق لعله المطلوب أسف تم أضافة المستلزمات الخدمية فى الباب الأول وبعد قرائة مرفقك الأخير قمت بإضافتها للباب الثانى والمرفق الثانى به طلبك قوائم منسدلة.rar قوائم منسدلة 2.rar

يفضل كتابة اسماء الحقول باللغة الإنجليزيى وعدم ترك مسافات فى الأسماء