ضاحي الغريب

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

السلام عليكم ورحمة الله وبركاته الأخ الكريم أ. عباد أبو نصار أستاذن منك ولي طلب أخر وشكرك مسبقا عندي معادلة في الخلية (B28) لايجاد صلاحية الاقامة من خلية التاريخ (B25) بالشكل التالي =IFERROR(IFERROR(" الأقامة تنتهي بعد "&DATEDIF(TODAY();$B$25;"y")&" سنة, "&DATEDIF(TODAY();$B$25;"ym")&" شهور و "&DATEDIF(TODAY();$B$25;"md")&" يوم ";" الإقامة أنتهــت منـذ "&DATEDIF($B$25;TODAY();"y")&" سنة, "&DATEDIF($B$25;TODAY();"ym")&" شهور و "&DATEDIF($B$25;TODAY();"md")&" يوم ");"") تحويلها الي كود ان أمكن وجزاك الله خيرا وبارك لك

اخي الاستاذ / عباد أبو نصار الكود جميل وفهمت فكرته لكن الجزء التالي ارجو شرحه For i = 1 To 35 جزاك الله خيرا عما تقدمه لنا من عون ومساعدة وجعله في ميزان حسناتك

السلام عليكم ورحمة الله وبركاته أخي الكريم الاستاذ عباد أبو نصار مايســترو الأكواد كل اعمالك بها افكار جميلة كودك اكثر من رائع جزاك الله خيرا وبارك الله لك تقبل تحياتي اخوك / ضاحي الغريب

السلام عليكم ورحمة الله وبركاته اخواني الكرام من فضلكم تعديل كود (vlookup) للاخ والمعلم أبو احمد (أ.عبدالله المجرب ) في احدي المشاركات قمت بتعديله بما يتناسب طلبي والحمد لله مضبوط لكن المشكلة عندي عندما لا يكون مقابل نتيجة للبحث تظهر علامة (N/A#) فبرجاء التعديل الكود حتي لا يظهر في الخلايا وجزاكم الله كل خير الكود Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Set MyRng = Sheets("DATA").[A1:AG1000] If Not Intersect(Target, [B8]) Is Nothing Then Cells(Target.Row + 3, 2) = Application.VLookup(Target, MyRng, 2, 0) Cells(Target.Row + 4, 2) = Application.VLookup(Target, MyRng, 20, 0) Cells(Target.Row + 5, 2) = Application.VLookup(Target, MyRng, 27, 0) Cells(Target.Row + 6, 2) = Application.VLookup(Target, MyRng, 6, 0) Cells(Target.Row + 7, 2) = Application.VLookup(Target, MyRng, 4, 0) Cells(Target.Row + 8, 2) = Application.VLookup(Target, MyRng, 12, 0) Cells(Target.Row + 9, 2) = Application.VLookup(Target, MyRng, 7, 0) Cells(Target.Row + 11, 2) = Application.VLookup(Target, MyRng, 23, 0) Cells(Target.Row + 12, 2) = Application.VLookup(Target, MyRng, 24, 0) Cells(Target.Row + 13, 2) = Application.VLookup(Target, MyRng, 25, 0) Cells(Target.Row + 14, 2) = Application.VLookup(Target, MyRng, 26, 0) Cells(Target.Row + 16, 2) = Application.VLookup(Target, MyRng, 18, 0) Cells(Target.Row + 17, 2) = Application.VLookup(Target, MyRng, 33, 0) Cells(Target.Row + 18, 2) = Application.VLookup(Target, MyRng, 19, 0) Cells(Target.Row + 19, 2) = Application.VLookup(Target, MyRng, 22, 0) End If End Sub

الاخ أكرم جلال لاخفاء ورقة واحدة مثلا الورقة 2 Sub hide_full() ورقة2.Visible = xlSheetVeryHidden End Sub ولا ظهارها استخدم الكود Sub show_sheets() ورقة2.Visible = True End Sub اظهار_اخفاء.rar

أخي الكريم بالأضافة الي ما قدمه لك أخي ومعلمي أ. عباد أبو نصار ..... وبعد أذنه بفرض ان باسورد الحماية علي الورقة "123" قم بوضع هذا السطر في بداية كود الطباعة ActiveSheet.Unprotect Password:="123" [code][/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5]في نهاية الكود ضع ذلك السطر لارجاع حماية الورقة كما كانت[/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5][code] ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True[/size][/font][/color] [code][/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5]وانت كنت تريد اذافة الغاء وارجاع احماية قبل باسم الورقة فرضا ان الورقة اسمها ورقة 1 وحماية الورقة 123 ضع ذلك في بداية الكود[/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5][code] ورقة1.Unprotect Password:="123"[/size][/font][/color] [code][/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5]وفي نهاية الكود [/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5][code] ورقة1.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True[/size][/font][/color] [code][/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5]وان شاء الله تظبط [/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5]وراجع المرفقات تم عمل المطلوب علي ملفك[/size][/font][/color] [color=#696969][font=times new roman', times, serif][size=5]وتقبل تحياتي[/size][/font][/color] boooook.rar

أخي النبيل / أبو احمد "أ.عبدالله المجرب" السلام عليكم ورحمة وبركاته فكرة الكود رائعة لاضافة تعليق وقمت بعد اذنك بتعديله ليصبخ Msg Box كما أريد بالصورة التالية MsgBox vbNewLine & " عدد الأسماء " & " ( " & Application.CountA(Range("B4:B1000")) & " ) " & " أسـم ", vbOKOnly, "شئـون الموظفين" وجزاك الله كل الخير عما قدمته وتقدمه لنا من عون دائما تقبل تحياتي أخوك / ضاحي الغريب

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

السلام عليكم ورحمة الله وبركاته أخواني في الله برجاء مساعدتكم في معادلة SUBTOTAL وتحويلها الي كود يظهر قيمته في message box بالمرفقات شرح لما اريد وجزاكم الله خيرا SUBTOTAL.rar

السلام عليكم ورحمة الله وبركاته الاخ الفاضل والمعلم الأستاذ / أبوعبدالله الكود أكثر من رائع لكن عندما قمت بنقله بنفس تسمية النطاقات ظهرت رسالة الخطأ التالية حاولت تكرارا وعند يأسي وعدم تمكني من معرفة الخطأ أرفقت لكم سطر الخطا عندي فارجوا منكم مساعدتي في اصلاح الخطأ ...... وجزاكم الله خيرا وبارك الله لكم وفي منتدانا وصرحـنا التعليمي "أوفيسنا" وجميع أسرته.

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

السلام عليكم ورحم الله وبركاته اخواني الاعزاء برجاء المساعدة عندي ملف يحتوي علي الكثير من البيانات واليوم فقط كلما احاول فتحه تظهر رسالة تمكين الماكرو وبعد الضغط علي تمكين تظهر الرسالة التالية ولا اتمكن من فتح الملف. وجزاكم الله خيرا بالمرفقات صورة الخطأ Error Message.bmp

عفوا اخي الكريم بسبب مشكلة عندي في الاتصال الملف بالمرفقات 485c40ce5f1.rar

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

الاخوة الأعزاء السلام عليكم ورحمة الله وبركاته برجاء المساعدة في عمل كود يقوم بترحيل العمود (B2) والعمود (R2) والعمود (U2) من صفحة العمل (DATA)وترحل البيانات الي صفحة العمل (INFO) الي العمود (B4) والعمود (C4) والعمود (E4) بشرط عدم تكرار البيانات او عمل كود حذف يقوم بحذف البيانات تلقائيا في صفحة العمل (INFO) العمود (B4-C4-E4) فقط ولكم جزيل الشكر

عفوا الكود بالمرفقات لعدم تمكني من رفعه بالشكل الصحيح الكود.txt

السلام عليكم ورحمة الله وبركاته الاخوة الأعزاء حصلت كود لاستاذنا ومعلمنا عبدالله أبوأحمد قمت بعمل تعديل عليه ليقوم بترحيل بيانات من صفوف معينة والحمد لله المحاولة نجحت لكن طلبي تعديل الكود بان يقوم بترحيل البيانات فقط بدون تنسيق والشيء الثاني كود مسح يعكس عمله لاني كل ما اقوم بترحيل البيانات بيكررها فهل من الممكن تعديل الكود ليقوم بترحيل البيانات الجديدة او عمل كود مسح لمسح البيانت قبل الترحيل لعدم التكرار ,جزاكم الله خير وبارك الله لكم في علمكم ورزقكم فيما قدمتوه لنا في هذا الصرح العظيم الذي نتعلم منه يوميا الجديد تقبلوا تحياتي الكود b OFFICNA() Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet Set ws = Sheets("DATA") Set ws2 = Sheets("HR") LR = ws.Range("B" & Rows.Count).End(xlUp).Row LR2 = ws2.Range("B" & Rows.Count).End(xlUp).Row If ws.Range("B2").Value = "" Then MsgBox ("áÇ ÊæÌÏ ÈíÇäÇÊ áÊÑÍíáåÇ") Else ws.Range("B2:b" & LR).Copy ws2.Range("B" & LR2 + 1) ws.Range("R2:R" & LR).Copy ws2.Range("C" & LR2 + 1) ws.Range("U2:U" & LR).Copy ws2.Range("E" & LR2 + 1) ws2.Select End If End Sub

الله أكبر ... الله أكبر .... لا اله الا الله الله أكبر ... الله أكبر ... ولله الحمد لكل المنتدي من أداريين ومشرفين وأعضاء لكل الامة الاسلامية عيد مبارك أدعوا الله أن يصلح حال أمتنا ويهبنا ثواب العشر وعظيم الأجر وفرحة عيد النحر

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

أخي الكريم //// الحسامي قال الصادق (صلي الله وعليه وسلم ) : أربعه لا ترد لهم دعوة.. الإمام العادل لرعيته, والأخ لأخيه بظهر الغيب يوكل به ملك يقول ولك مثل ما دعوت لأخيك , والوالد لولده, والمظلوم يقول الرب تبارك وتعالى : وعزتي وجلالي لأنتصرن لك ولو بعد حين فا بظهر الغيب ندعو لك اللهم يبارك لك في علمك وعملك وذريتك وأهلك وبرجاء اعادة تحميل المرفقات مرة وجزاك الله كل خير تقبل تحياتي

استاذنا الكبير المبدع دينامو المنتدي الاستاذ والاخ الكريم / عبدالله المجرب "أبواحمد" كلما دخلت لاوفيسنا وجد مشاركة او مشاركات عدة لك وكل مشاركة اجد فيها شيء جديد اتعلم واقتبس منه لا يسعني ان اقول لك انت نعم المعلم بارك الله لك وبارك لك في اولادك ويجعلهم من الصالحين وجزاك الله كل خير

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

اخواني أبواحمد "أ.عبدالله المجرب "والاستاذ محمد جزاكم الله كل خير اكواد جميلة

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