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

أخي الحبيب ياسر العربي أبدعت في فكرتك الرائعة وإن كانت سلاح ذو حدين حيث سيكون من السهل في هذه الحالة زرع فيروسات بمنتهى السهولة ..عوامل الأمان اتكسرت طيب عندي فكرة بس مش عارف مدى إمكانيه تطبيقها بالنسبة لملف الإكسيل نفسه هل يمكن أن يدمج في الملف التنفيذي بحيث لا يكون له وجود على الإطلاق .. أو سؤال آخر بعيداً عن الفيجوال بيسك 6 هل يمكن إجبار المستخدم على عدم القدرة على فتح محرر الأكواد إذا لم يكن الماكرو مفعل ؟؟؟؟!!! هذا السؤال لو وجدت له إجابة ستحل مشاكل الحماية على الإطلاق

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

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

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

ضع الكود مع الأكواد الأخرى الموجودة في حدث المصنف .. في أي مكان ..!! روح لمحرر الأكواد Alt + F11 وانقر دبل كليك على ThisWorkbook ثم ضع أكوادك في هذا الموديول ..

يكفي أن تقوم بالتعديل التالي Private Sub Workbook_BeforePrint(Cancel As Boolean) Cancel = True End Sub يوضع في حدث المصنف

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

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

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

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

بارك الله فيك أخي الكريم موريادي على قوة الملاحظة تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته ؛؛ أخي الكريم محمد عبد الناصر لا يوجد كود سيقوم بتفعيل الماكرو بشكل تلقائي لأن الماكرو لو معطل كيف سيعمل الكود حتى وإن وجد ؟؟!! الطريقة الوحيدة هي تشغيل ملف الريجستري ... جرب الملف المرفق التالي (انقر دبل كليك على الملف المناسب لنسخة الأوفيس لديك) Registry.rar

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

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

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

جرب الكود التالي عله يفي بالغرض ويحل المشكلة تماماً Sub Find_All() Const nGroup As Long = 25 Const nInsert As Long = 3 Dim Ws As Worksheet, Sh As Worksheet Dim myDate1 As Double, myDate2 As Double Dim arr1 As Variant, arr2 As Variant Dim I As Long, J As Long, P As Long, mCol As Long Set Ws = Sheets("add") Set Sh = Sheets("Aldata") Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next Sheets("Temp").Delete Sheets.add.Name = "Temp" On Error GoTo 0 If IsDate(Sh.Range("W2")) And IsDate(Sh.Range("W3")) Then myDate1 = Sh.Range("W2"): myDate2 = Sh.Range("W3") End If With Sh If .Cells(Rows.Count, 2).End(xlUp).Row > 5 Then .AutoFilterMode = False .Range("B5:S5").AutoFilter Field:=1, Criteria1:="<>" .Range("B6:S" & .Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).ClearContents .AutoFilterMode = False End If End With With Ws .AutoFilterMode = False .Range("A2:S2").AutoFilter Field:=4, Criteria1:=">=" & myDate1, Operator:=xlOr, Criteria2:="<=" & myDate2 If Sh.Range("U3").Value <> "الكل" Then .Range("A2:S2").AutoFilter Field:=2, Criteria1:=Sh.Range("U3").Value mCol = Application.Match(Sh.Range("V2").Value, .Rows(2), 0) .Range("A2:S2").AutoFilter Field:=mCol, Criteria1:=Sh.Range("V3").Value .Range("A2").CurrentRegion.Offset(2).SpecialCells(xlCellTypeVisible).Copy Sheets("Temp").Range("A1") .AutoFilterMode = False End With Sheets("Temp").Columns(1).Delete arr1 = Sheets("Temp").Range("A1").CurrentRegion.Value I = ((UBound(arr1, 1) \ nGroup) + 1) * (nGroup + nInsert) arr2 = Sh.Range("A6").Resize(I, UBound(arr1, 2)).Formula For I = 1 To UBound(arr1, 1) P = P + 1 For J = 1 To UBound(arr1, 2) arr2(P, J) = arr1(I, J) Next J If I Mod nGroup = 0 Then P = P + nInsert Next I Sh.Range("B6").Resize(UBound(arr2, 1), UBound(arr2, 2)).Formula = arr2 Sheets("Temp").Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub تقبل تحياتي

لم أقهم المقصود من كلامك ..ممكن توضح أكثر .. أعتقد الكود يعمل مع أي فلترة موجودة في ورقة العمل وليس في نطاق محدد

أخي الكريم صلاح استخدام كلمة Sheets فقط في هذا السطر استخدام سيء إلى حدٍ ما For Each Sh In Sheets الأفضل استخدام كلمة Worksheets إذ أن كلمة Sheets تتعامل مع كل أنواع أوراق العمل بما فيها Charts .. وهذا قد يسبب مشاكل في حالة وجود ورقة عمل Chart في ملفك أما استخدام نطاق محدد كما وضعت A1:C5000 فسيء أيضاً حيث قد تزيد البيانات أو تنقص أما استخدام CurrentRegion فإنه يكيف النطاق الحالي للعمل عليه أياً كان مدى هذا النطاق بالنسبة لكود الأخ الحبيب عبد السلام فهو جيد ولكن يعيبه حدوث أخطاء وقد تجنب الأمر بوضع جملتين لتجنب الأخطاء أما إذا أزيلت هاتين الجملتين فإنه يحدث خطأ في حالة أن الفلترة غير قائمة أو أن الفلترة قائمة ولا يوجد شروط للتصفية (وأنا أفضل الابتعاد عن تلك الجمل ومعالجة الموقف بالكود نفسه) عموماً كل السبل تؤدي المطلوب إن شاء الله تقبل تحياتي

وعليكم السلام أخي العزيز صلاح جرب الكود التالي Sub Test() Dim Sh As Worksheet For Each Sh In ThisWorkbook.Worksheets Sh.AutoFilterMode = False Sh.Range("A1").CurrentRegion.AutoFilter Next Sh End Sub تقبل تحياتي

هلا قمت بالأمر لأنني لدي مشاغل كثيرة الآن وبعد العمل على الملف قم برفعه مرة أخرى للعمل عليه إن شاء الله

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

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

أخي العزيز دغيدي يمكن الإطلاع على الرابط التالي للاستفادة منه إن شاء الله الرابط من هنا

لم تجبني على سؤالي أخي الكريم هشام يوجد العديد من الاحتمالات .. فكيف سيكون الحل في هذه الحالة؟ انظر للصورة التالية ..هذه الاحتمالات للأرقام 185 و 21.6 ...مع العلم بأن الأرقام المدرجة في مثالك بها كسر بسيط جداً جداً وهو الرقم 83.0000000000001 4 159 22 7 155 23 13 147 25 16 143 26 19 139 27 22 135 28 25 131 29 28 127 30 31 123 31 34 119 32 37 115 33 40 111 34 43 107 35 46 103 36 55 91 39 58 87 40 73 67 45 76 63 46 79 59 47 94 39 52 97 35 53 100 31 54 103 27 55 106 23 56 109 19 57 112 15 58 115 11 59

وضح الخلايا التي تريد التعديل عليها .. هل الخلايا في تسلسل منتظم أم أنها متباعدة ؟ يرجى توضيح عناوين الخلايا المطلوب العمل عليها