ياسر خليل أبو البراء

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

الأخ الفاضل أبو حبيبة إليك الملف التالي .. قم بتنفيذ الكود سيظهر لك مربع إدخال InputBox حدد النطاق المراد طباعته فيتم نسخه إلى الجدول رقم 4 ثم يتم طباعته Print Specific Table YasserKhalil.rar

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

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

أخي الحبيب الغالي سعد عابد مشكور على المباركة بالترقية وعقبالك يا كبير تقبل تحياتي

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

قمت بتنصيب أوفيس 2010 ولم أجد المكتبات التي أشرت إليها ونفس المشكلة مع الملف ... فيه إضافة بتنصبها ؟؟

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

أخي الفاضل جرب الملف التالي وإن شاء الله يكون المطلوب فقط قم بالكتابة في الخلية D4 لا تنسى أن تختار المشاركة التي أعجبتك كأفضل إجابة ليظهر الموضوع منتهي Try This.rar

ارفق الملف لأني كنت محتاج ملف من هذا النوع ليس لكسره بل لمعرفة كيف تم عمله

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

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

قد يكون اختلاف النسخة هو السبب في عدم عمل الملف عندي .. عموما ننتظر أيضاً ردود الأخوة الذين لديهم نفس الإصدار ليقرروا إذا ما كان الملف يعمل أم لا

جرب الكود بهذا الشكل Sub NewMonth_Sheet() Dim lSht As Worksheet Dim nSht As Worksheet Dim shName As String Set lSht = Sheets(Sheets.Count) If IsDate(lSht.Name) Then shName = Application.Proper(Format(DateAdd("m", 1, lSht.Name), "mmmm-yyyy")) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error Resume Next 'Tests that sheet doesn't already exist Set nSht = Sheets(shName) On Error GoTo 0 If nSht Is Nothing Then lSht.Copy after:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = shName Else MsgBox "Sheet """ & shName & """ already exists!", vbCritical End If Else MsgBox "Last sheet name does not" & Chr(10) & "represent a month!", vbCritical: Exit Sub End If For Each ce In [B9:J39] If ce.HasFormula = True Then GoTo 10 ce.ClearContents 10 Next Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

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

مين قالك إنك آذتني ..قولي بس مين هو وأنا أقطع لك لسانه .. مفيش زعل ولا غضب ولا إيذاء من أحبتي في الله تقبل ودي وتحياتي

الأخ الحبيب هاني بدر مشكور على مرورك العطر .. وبلاش تصعبها عليا بالعمليات لحسابية المعقدة دي ..دا الرقم اللي هيطلع ممكن يكون Out of Range .. بارك الله فيك الأخ الحبيب الغالي أبو محمد عباس لقد وقفت الكلمات عاجزة أمام ردك .. ولا أجد من الكلمات إلا جزاكم الله خيراً على هذه المشاعر الطيبة الأخ الحبيب عبد الله المجرب بلوم عليك ...مش عشان متأخر في الرد . لا عشان متأخر في تواجدك الدائم بالمنتدى ، فأنت علم من أعلام المنتدى ونحب الاستزادة من خبراتك ..(اللي إحنا بنعمله لعب عيال جنب اللي ممكن تقدموه .. في انتظار مشاركاتكم وتواجدكم معنا .. هذا يسعد قلوبنا) أشهد الله إخواني أني أحبكم في الله

الأخ الغالي خالد المكتبات التي في الصور ليست موجودة عندي ..هل هي خاصة بإصدار أحدث أم أنه يمكن تنصيبها على أي إصدار؟؟ أرجو الإفادة

الأخ ناصر سعيد http://www.officena.net/ib/index.php?showtopic=60730 اطلع على الرابط

مش عايز شكر .. النهاردة الجمعة وإن شاء الله متنساش تدعي لي (مش تدعي عليا) لا تنسى إخوانك بدعوة بظهر الغيب .. عسى الله أن يتغمدنا برحمته :gift2: تقبل تحياتي

أخي الكريم صلاح الدين أولاً أحب أن تقوم بتغيير اسمك كما في اليوتيوب ثانياً من هذا الذي انفجر غضباً في وجهك غيري !! لم و لن يتأفف أحد أخي الحبيب من كثرة الطلبات ، كل ما في الأمر هو تنظيم الموضوع الواحد بحيث يكون كل طلب له موضوع مستقل ، ومرفق واحد للعمل عليه (مش كل شوية الاقي مرفق مختلف عن التاني) ثالثا بالنسبة لشرح الأكواد هناك موضوع تم طرحه من فترة باسم المشروع الكبير .. مكتبة الصرح الزاخرة بالشرح وبها أكواد لا بأس بها ، وفي التعليمات شرح وتفصيل لمعظم الأكواد وكيفية استخدامها .. ابحث عن الرابط وستجده إن شاء الله وقم بتحميل النسخة الأخيرة مباشرة ..عشان متعبكش يا أبو الصلح تقبل تحياتي

الأخ الحبيب فضل الأخ الحبيب زيزو بارك الله فيكما وجزاكما الله كل خير ، وعقبال الجميع إن شاء الله تسلموا على كلامكم الرقيق .. والله إني أحبكم في الله تقبلوا تحياتي

يا رب يكون آخر طلب أخي صلاح .. بهزر معاك طبعاً ..اطلب براحتك بس يا ريت ميكونش كله في موضوع واحد ! 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 تقبل تحياتي

أخي الحبيب عبد الله مشكور على المجهود الكبير ..بارك الله فيك الأخ الفاضل scania يرجى إرفاق ملف للتوضيح ..

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