هادى محمد المامون سالم

بسم الله الرحمن الرحيم اللهم وفق اخى خبور لما يحبه و يرضاه اخى سالم : برجاء وضع رابط الموضوع السلام عليكم

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

بسم الله الرحمن الرحيم طبعا ممكن نضحك على vba انسخ الكود التالى فى صفحه اكواد ورقه العمل Private Sub Worksheet_Activate() Application.CommandBars("cell").Enabled = False End Sub Private Sub Worksheet_Deactivate() Application.CommandBars("cell").Enabled = True End Sub مرفق ملف يغلق الماوس فى Sheet1 فقط و باقى اوراق العمل يعود الوضع الطبيعى للماوس السلام عليكم Right_Click.rar

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

جزاك الله خيرا لكن الاهم الاستمراريه

بسم الله الرحمن الرحيم فى الجون كيف أختار البيانات بنفسي؟؟؟؟؟؟ بمعنى عند وقوفك فى اى خليه مثل A1 يقوم الكود بمعاينه مجال البيانات المحيطه بها ثم جرب الوقوف بالخليه D2 ثم جرب الكود ستجد البيانات الظاهره فى معاينه الطباعه مختلفه و هكذا , اما موضوع هات مصحف احلف لك عليه ان كودى ليس به A1 و لا حتى A4 و علشان موضوع الصدقه الجاريه اليك كود بسيط جدا يقوم بمعاينه نطاق الطباعه الذى تحدده( Selection) و ليس البيانات المتجاوره Sub My_PrintPreview_01() Selection.PrintPreview End Sub مرفق ملف السلام عليكم My_PrintArea_01.rar

بسم الله الرحمن الرحيم طريقه اخرى مرفق ملف (شبه برنامج) يقوم تلوين الشهادات التى انتهت تواريخها بمجرد فتحك للملف (محدث تلقائيا) مفتاح لاعاده التلوين بعد التعديل مفتاح لاستخراج تقرير لجميع الشهادات المنتهيه بالاضافه الى ارقامها السلام عليكم Date.rar

بسم الله الرحمن الرحيم طريقه اخرى و ليس تعديل كود مختصر لمعاينه البيانات المتجاوره التى تختارها بنفسك Sub My_PrintArea() ActiveSheet.PageSetup.PrintArea = _ ActiveCell.CurrentRegion.Address ActiveSheet.PrintPreview End Sub مرفق ملف السلام عليكم My_PrintArea.rar

بسم الله الرحمن الرحيم الف مبروك و الى الامام دائما السلام عليكم

بسم الله الرحمن الرحيم If sheet2.Cells(i, 2).Value = "Cairo" Then أعتقد ان .Value قد لاتعمل مع Text مثل "Cairo" جرب التعديل If sheet2.Cells(i, 2)= "Cairo" السلام عليكم

بسم الله الرحمن الرحيم قد اجد صعوبه لانى عند الكتابه باللغه العربيه داخل الكود و انسخه بالمنتدى لا تظهر الكتابه باللغه العربيه اخى احمد استخدم الكود التالى Sub Hady_AA11() Dim My_Sheet As String My_Sheet = "Sheet3" Call MY_Function(My_Sheet) End Sub Private Function MY_Function(My_Sheet) Sheets(My_Sheet).[AA11] = Sheets(My_Sheet).Name End Function السلام عليكم

بسم الله الرحمن الرحيم ستجد الحل ان شاء الله فى الملف المرفق السلام عليكم Pound.rar

بسم الله الرحمن الرحيم مشكور اخى احمد يعقوب و لقد طالت غيبتك عن القاهره مشكور اخى YasserKhalil و قد يكون انقطاعى لظروف خاصه عن استكمال الدوره هو نهايه الدوره نفسها لاعتقادى ان المرحله المقبله قد تخرج خارج نطاق المتوسطين مما جعلنى استعد للمشروع جديد قد يكون مفاجاه( و لاهميته بالنسبه لى لانى سوف اقدمه ان شاء الله كصدقه جاريه(لوالدى رحمهما الله) من العلم النافع الذى قاما بتعليمه لى ليعمل به من أراد ) احاول ان اقم بالانتهاء منه اولا ثم تقديمه كدروس مسلسله 0 و لكنى سوف أحاول تقديم معلومات سريعه و مفيده فى هذا الموضوع على قدر المستطاع اليكم معلومه سريعه لاختصار العمل مع vba بالمشاركه رقم 63 ارفقت الكود التالى Sub Hady() Dim i As Integer For i = 1 To 3 If Sheets("Sheet1").Cells(i, "A").Value = "Hady1" Then MsgBox (Sheets("Sheet1").Cells(i, "A")) End If Next i End Sub هذا الكود لا يتم تطبيقه الا على "Sheet1" و اذا اردت التعديل الى ورقه عمل أسمها "Main" مثلا يجب البحث عن كلمه Sheet1 فى كامل ورقه العمل سنقوم بتعريف اجراء رئيسى نقوم بتعريف اسم و رقه العمل كذلك العداد "i" كمتغيرين سوم نقوم بارسالهما الى الداله الاخرى لتقوم باداء المهمه المطلوبه و بذلك عند تغيير اسم ورقه العمل او العداد ماعليك الا التغيير فى الاجراء الرئيسى فقط و سوف يتم التفعيل فى باقى الكود بالاسماء الجديده 0 Sub Hady() Dim i As Integer Dim My_Sheet As String My_Sheet = "Main" For i = 1 To 3 If Sheets(My_Sheet).Cells(i, "A").Value = "Hady1" Then Call MY_Function(My_Sheet, i) End If Next i End Sub Private Function MY_Function(My_Sheet, i) MsgBox (Sheets(My_Sheet).Cells(i, "A")) End Function و بذلك يصبح الكود نموذج جاهز يمكن الاحتفاظ به فى ورقه العمل Personal تستخدمه متى تريد مع التعديل السريع السابق شرحه مرفق ملف السلام عليكم MY_Function.rar

بسم الله الرحمن الرحيم طالما انك طلبت الحل عن طريق الكود عند محاوله البحث فى اكثر من شرط و استخراج النتائج يتم اضافه البيانات الاساسيه التى لا تتغير فى ورقه عمل و لنطلق عليها "ID" مثل الحاله الاجتماعيه و عدد الابناء و لكن الاضافه هنا انك من الممكن ان تنفصل لا قدر الله او ترزق بمولود و لذلك بالملف المرفق عند تعديل البيانات فى "ID" سيتم التعديل تلقائيا فى ورقه البيانات المتغيره و اعمده النتائج فى ورقه العمل الثانيه و هى "List" مرفق ملف السلام عليكم Find.rar

بسم الله الرحمن الرحيم عمل رائع بصراحه جميع اعمالك رائعه السلام عليكم

بسم الله الرحمن الرحيم هل النسخه دائمه السلام عليكم

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

بسم الله الرحمن الرحيم ملحوظه عند قيامى بتحميل ملف اخى mr mostafa osman اختفى شريط DisplayFormulaBar و قمت باعادته بالكود التالى Sub ttt_ON() Application.ActiveWindow.DisplayOutline = True End Sub السلام عليكم

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

بسم الله الرحمن الرحيم الاخوه : مزلزل galal mk omar1 aysam almaistro الف مبروك و مرحبا بكم السلام عليكم

بسم الله الرحمن الرحيم استخد الكود Sub DOIT() Dim ER As Integer ER = Sheets("Sheet1").Range("A1").CurrentRegion.Rows.Count ActiveSheet.Rows(ER).Select End Sub مرفق ملف السلام عليكم Row.rar

بسم الله الرحمن الرحيم لقد قمت بعمل الداله فى ورقه عمل "List" بالكود التالى Public Function ER() As Integer ER = Range("A1").CurrentRegion.Rows.Count End Function و وظيفتها فتح مجال الفواتير فعند القيام باضافه فواتير جديده يتم اضافتها تلقائيا فى combobox و كذلك العكس , فتقوم الداله بعد نهايه السطور التى يوجد بها بيانات و اعطاءها رقم لاستخدامه فى لانهاء جمله For و هذا مثال مبسط ل ER Sub DOIT() Dim ER As Integer ER = Range("A1").CurrentRegion.Rows.Count MsgBox (ER) End Sub مرفق ملف السلام عليكم ER.rar

بسم الله الرحمن الرحيم الصبر جميل ستجدى الحل بالملف المرفق السلام عليكم Invoice.rar

بسم الله الرحمن الرحيم و هذا الكود يقوم بنقل محتويات المصفوفه الى و رقه العمل Sub DOIT() Dim SH As String: SH = "Sheet1" Dim i, cnt As Integer: cnt = 1 Dim MyWeek, MyDay MyWeek = Array("Sat", "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun") Sheets(SH).Range("A1:A7").ClearContents For i = 0 To 6 Sheets(SH).Cells(cnt, "A") = MyWeek(i) cnt = cnt + 1 Next i End Sub مرفق ملف السلام عليكم Array_01.rar

بسم الله الرحمن الرحيم و هذا مثال مايكروسوفت الذى تجده بHelp Example ". وقد قمت بالتعديل عليه لاظهار ايام الاسبوع عن طريق Array بالكود التالى Sub DOIT() Dim MyWeek, MyDay MyWeek = Array("Sat", "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun") For i = 0 To 6 MyDay = MyWeek(i) MsgBox (MyDay) Next i End Sub مع ملاحظه اننا قمن بمناداه ايام الاسبوع بعد تعريفها MyDay بوضعها بين قوسين مرفق ملف السلام عليكم Array.rar