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

في انتظار على نار .. للشرح الجبار لا تتأخر علينا يا عربي يا مغوار

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

أخي الحبيب حسام عيسى أشم في مشاركتك وموضوعك رائحة لا أحب أن أشمها فهلا عدلت عما أنت بصدده؟!!! تقبل وافر تقديري واحترامي

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

بارك الله فيك أخي الغالي الزباري وجزيت خيراً على الموضوعات المتميزة والحصرية تقبل وافر تقديري واحترامي

أختنا الكريمة يثرب أهلاً بك في المنتدى ونورتي بين إخوانك يرجى تغيير اسم الظهور للغة العربية ، وإن شاء الله بمتابعة المنتدى ستسفيدين الكثير والكثير تقبلي تحياتي

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

أخي العزيز هشام محمد شرقاوي لغة البرمجة تعني المنطق في الطلب ، وقد طلبت أمراً ما ، ويوجد الكثير من الاحتمالات ..فقم بتحديد أي الاحتمالات أقرب إليك والذي يمكنه أن يحل مشكلتك بشكل جذري .. مع العلم بأن الاحتمالات التي أرفقتها هي مجرد جزء من الاحتمالات إذ أنني أدرجت لك فقط الاحتمالات التي تحمل أرقام صحيحة مع العلم يوجد احتمالات لكسور ..أي أن الموضوع بهذا الشكل غير منطقي حاول تحدد معايير للاحتمال المطلوب .. ما رأيك مثلاً في أن يكون المجموع (على سبيل المثال 185) يقسم على 2 والناتج أو أقرب ناتج له يكون الأساس في العمل إذا كنت توافقني هذا الاقتراح فأعلمني بذلك ، وإذا كان لديك فكرة أخرى أو اقتراح آخر فلتتفضل به وإن شاء الله نصل لحل .. تقبل تحياتي Goal Seek To Calculate Tax YasserKhalil Officena.rar

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

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

أخي الكريم أبو حمادة يبدو لي أنك تقوم بتغييرات في الكود .. مما يتسبب في حدوث مشاكل إليك الملف المرفق التالي لم يتم فيه تنفيذ الكود .. يعني نسخة أصلية كما أرفقتها في مشاركة سابقة .. جرب الملف وأعطي ملاحظاتك !! انقر على صورة "إنا فتحنا لك فتحاً مبيناً" ... لو فيه أية ملاحظات يرجى ذكر ملاحظة واحدة فقط .. وتذكر كيف حدثت المشكلة ؟ أي ما هي الإدخالات التي سببت المشكلة؟ لن ارفق أكواد .. سأرفق ملف مرفق وأمري لله Filter Data By Dates & Transfer Skipping Formula Rows YasserKhalil.rar تم تعديل الملف المرفق .. دعك من الإصدار الأول للملف ..جرب الملف التالي (الإصدار الثاني) حيث اكتشفت بعض الأخطاء وتمت معالجتها إن شاء الله Filter Data By Dates & Transfer Skipping Formula Rows YasserKhalil V2.rar

أخي الكريم وائل أنا لم أعدل المشاركة إنما وضعت مشاركة جديدة بعد رؤيتي لمشاركتك الأخيرة ، والمنتدى يقوم بدمج المشاركات في حالة إذا كان التوقيت قريب!! تقبل تحياتي

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

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

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

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

أخي الكريم محمد عبد الناصر بعد الإطلاع على ملفك جرب التعديل التالي أولاً الموديول رقم 1 قم بوضع الكود التالي بدلاً من الكود الموجود حيث تمت إضافة بعض الأسطر Public PrvntPrnt Sub Print_Specific_Pages_In_ActiveSheet() Dim Arr, SH As Worksheet, Rng As Range, Cell As Range, I As Long Set SH = ActiveSheet PrvntPrnt = 1 With SH ReDim Arr(0 To .HPageBreaks.Count + 1) If Len(.PageSetup.PrintTitleRows) Then Set Rng = .Range(.PageSetup.PrintTitleRows) Arr(0) = Rng.Rows(Rng.Row + Rng.Rows.Count).Row Else Arr(0) = 1 End If For I = 1 To .HPageBreaks.Count Arr(I) = .HPageBreaks(I).Location.Row Next I Arr(UBound(Arr)) = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1 For I = UBound(Arr) To (LBound(Arr) + 1) Step -1 Set Rng = Intersect(.Rows(Arr(I - 1) & ":" & (Arr(I) - 1)), .UsedRange, .Columns("G")) If Not Rng Is Nothing Then For Each Cell In Rng If Cell.Value > 0 Then On Error GoTo Skipper .PrintOut From:=I, To:=I Exit For End If Next Cell End If Next I End With Skipper: PrvntPrnt = 0 End Sub ثانياً قم بوضع الكود التالي في حدث المصنف ThisWorkbook Const Warning As String = "Warning" Private Sub Workbook_Open() Dim Ws As Worksheet PrvntPrnt = 0 Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets Ws.Visible = xlSheetVisible Next Ws Sheets(Warning).Visible = xlVeryHidden Application.ScreenUpdating = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Ws As Worksheet Application.ScreenUpdating = False Sheets(Warning).Visible = xlSheetVisible For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> Warning Then Ws.Visible = xlVeryHidden End If Next Ws Application.ScreenUpdating = True ActiveWorkbook.Save End Sub Private Sub Workbook_BeforePrint(Cancel As Boolean) If PrvntPrnt = 0 Then Cancel = True: MsgBox "PRINT Disabled", vbCritical End Sub ولا تنسى أن تقوم بتعيين الماكرو في زر الأمر الموجود في ورقة العمل Sheet1 ..كليك يمين على زر الأمر ثم Assign Macro واختر الإجراء الفرعي المسمى Print_Specific_Pages_In_Activesheet لابد أن تقوم بتنفيذ الخطوات بنفسك لتتعلم وترتقي والموضوع ليس بمستحيل ولا بصعب .. يمكنك الرجوع إلى موضوع "بداية الطريق لانقاذ الغريق" لتعرف التعامل مع البدايات والأساسيات للتعامل مع محرر الأكواد رابط الموضوع من هنا

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

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

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

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

جرب التعديل التالي رغم أن الكود يعمل لدي ولم ألاحظ المشكلات التي تتحدث عنها ، عموماً قم بتجربة الكود مرة أخرى بعد التعديل وإذا وجدت ملاحظات فيرجى ذكر ملحوظة واحدة فقط في كل مرة للتركيز عليها ومعالجتها ..لأن الكود طويل ويحتاج لتدقيق ... بدأت أفقد السيطرة على الكود 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 On Error GoTo Skipper 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 Skipper: Sheets("Temp").Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub لا تنسى وضع ملاحظة واحدة فقط للعمل عليها .. مع وضع وإرفاق ملف أصلي لم يتم تنفيذ الكود عليه ، أي قم بتجربة الكود ولكن بدون حفظ على الملف حتى أرى المشكلة التي تحدث بعيني .. مع ذكر متى تحدث المشكلة بالضبط ؟

أخي الكريم لابد من تعلم الأساسيات في التعامل مع محرر الأكواد .. لا أعرف ما المشكلة لديك عموماً جرب الملف المرفق Force Users To Enable Macros In Workbook YasserKhalil.rar

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

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