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

الأخ ناصر هو فين ؟ هو مين ؟ هو إزاي ؟ هو ايه ده !!!!!!!!!! أقطع دراعي إذا كنت فاهم كلامك .هل الكلام يخص الموضوع ؟ ولمين موجه الكلا (الكلام يعني !!) .. ولا إنت تقصد تهزر :eek2:

جرب الكود بهذا الشكل .. Private Sub Workbook_Open() Application.ScreenUpdating = False Application.EnableCancelKey = xlDisabled Application.Visible = False Userform1.Show Workbooks.Application.Visible = True Sheet1.Select Range("A1").Value = "" Sheet1.Range("A1").Value = 1 Worksheets(1).ScrollArea = "A1" Sheet2.Visible = True Sheet2.Select Application.ScreenUpdating = True End Sub

أخي الحبيب رفيع سعد (طير إنت) ربنا يكرمك ويبارك فيك ...أنا فعلا لم أنساك ولن أنساك ، ومن استفاد من هذه الحلقات لو عرف إنك نواة هذه الحلقات ، أكيد بردو مش هينسوك تقبل تحياتي

أخي الغالي سليم مفيش أسرار بينا في المنتدى .إخواتنا بردو وليهم حق علينا .مش كدا ولا ايه ..

أختي الكريمة هل اطلعتي على المشاركة رقم 6 و 7 ؟!!!!!!!!!! :Rules:

الاخ سليم يقصد إنك تروح للتبويب Formulas هتلاقي في آخر التبويب Calculation Options اختار Automatic

وهذه طريقة أخرى لتؤدي نفس الغرض IsFormula UDF.rar

الأخت الفاضلة جربي هذا الملف وإذا كان هذا هو المطلوب سيتم الشرح بإذن الله كيفية تنفيذه Identify Formulas By Conditional Formatting.rar

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

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

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

شرحت الطريقة في المشاركة السابقة ..فقط قومي بتحديد عمود الصافي المراد إظهار الثوابت فيه والمعادلات .. سيقوم الإكسيل بتحديد الثوابت في حالة اختيار Constants وتحديد المعادلات في حالة اختيار Formulas إذا لم تكن الإجابة كافية فيرجى توضيح المطلوب بشكل آخر !!

الأخت الفاضلة نهال مرحبا بك في المنتدى بين إخوانك وأخواتك أولاً وقبل أي شيء يرجى فيما بعد عند طرح موضوع أن يكون عنوان الموضوع واضح ويدل على مضمون الطلب وليس كما في حالتك (سؤال).. بالنسبة لطلبك أنا أعمل على أوفيس 2007 : لتحديد الخلايا التي تحتوي على ثوابت يتم الضغط على Ctrl + G من لوحة المفاتيح ، ثم النقر على زر Special ثم تظهر نافذة اختاري منها Constants فيتم تحديد كل الخلايا التي تحتوي على الثوابت (والثوابت قد تكون أرقام أو نصوص أو تواريخ أو حتى فراغات بالمسطرة) لتحديد المعادلات يتم تنفيذ نفس الخطوات السابقة ولكن يتم اختيار Formulas بدلاً من Constants بالنسبة للمعادلات فإنها تبدأ دائماً بعلامة يساوي =

الأخ المشاكس رفيع سعد من كان حليفا فليحلف بالله أو ليصمت (متقولش والنبي تاني وإلا مش هعبرك تاني ههههه) .. أتعبتني ..وولكن ولا يهمك المهم تدعي للكبير ابن مصر ولا تنساني أنا الآخر بدعوة بظهر الغيب Sub TransferProducts() 'تعريف المتغيرات Dim ws, ws2 As Worksheet Dim lr, lr2 As Long '[Data]لورقة العمل التي باسم[ws]تعيين المتغير Set ws = ThisWorkbook.Sheets("Data") '[All]لورقة العمل التي باسم[ws2]تعيين المتغير Set ws2 = ThisWorkbook.Sheets("All") '[ws]في ورقة العمل[K]تعيين رقم آخر صف به بيانات في العمود lr = ws.Cells(Rows.Count, 11).End(xlUp).Row '[ws2]تعيين رقم أول صف فارغ في العمود الرابع في ورقة العمل lr2 = ws2.Cells(Rows.Count, 4).End(xlUp).Row + 1 'إيقاف خاصية إهتزاز الشاشة Application.ScreenUpdating = False 'إظهار رسالة تفيد بتأكيد الترحيل من عدمه ، فإذا تم الضغط على زر الأمر لا يتم الخروج من الإجراء الفرعي If MsgBox(" هل تريد بالتأكيد ترحيل البيانات ومسحها" & vbCr & vbCr & String$(40, "="), vbCritical + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading + vbDefaultButton2, "تاكيد الترحيل ") = vbNo Then Exit Sub '[H3:J3]يتم نسخ بيانات الزبون الموجودة في النطاق ws.Range("H3:J3").Copy '[ws2]بعد عملية النسخ يتم لصق البيانات في العمود الأول في ورقة العمل ws2.Range("A" & lr2).PasteSpecial (xlPasteValues) 'يتم نسخ النتائج التي تم استخراجها من الكود السابق ws.Range("K3:M" & lr).Copy 'يتم لصق البيانات ولكن بشكل أفقي وليس عمودي في بداية العمود الرابع ws2.Range("D" & lr2).PasteSpecial (xlPasteValues), , , True 'إلغاء خاصية النسخ واللصق Application.CutCopyMode = False '[ws]مسح النطاق الذي يحتوي على النتائج حتى آخر خلية بها بيانات في ورقة العمل ws.Range("K3:M" & lr).ClearContents '[clear]استدعاء الإجراء الفرعي المسمى Call clear 'إعادة تفعيل خاصية إهتزاز الشاشة Application.ScreenUpdating = True End Sub Sub clear() 'تعريف المتغيرات Dim ws As Worksheet Dim lr, lr2, lr3 As Long Dim i, y As Integer '[Data]لورقة العمل التي باسم[ws]تعيين المتغير Set ws = ThisWorkbook.Sheets("Data") '[ws]تعيين رقم آخر صف به بيانات في العمود الأول في ورقة العمل lr = ws.Cells(Rows.Count, 1).End(xlUp).Row '[ws]بدء التعامل مع ورقة العمل With ws 'حلقة تكرارية للأعمدة من العمود الثاني إلى العمود الخامس For y = 2 To 5 'حلقة تكرارية من الصف الثالث وحتى آخر صف به بيانات For i = 3 To lr Step 6 'يتم مسح الخلاياالتي بها الكميات .Cells(i + 1, y).Value = "" Next i Next y End With End Sub

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

الاخ الحبيب رفيع إليك شرح الكود الأول - وكفاية عليا كدا - .. Sub FilterProduct() 'تعريف المتغيرات Dim ws As Worksheet Dim lr, lr2, lr3 As Long Dim i, y As Integer '[Data]لورقة العمل التي باسم[ws]تعيين المتغير Set ws = ThisWorkbook.Sheets("Data") 'تعيين رقم آخر صف به بيانات في العمود الأول lr = ws.Cells(Rows.Count, 1).End(xlUp).Row 'إيقاف خاصية إهتزاز الشاشة Application.ScreenUpdating = False 'بدء التعامل مع ورقة العمل With ws 'مسح النطاق الذي تظهر فيه النتائج .Range("K3:M1000").ClearContents 'حلقة تكرارية للعمود الثاني والثالث والرابع والخامس For y = 2 To 5 '[K]متغير لتحديد أول خلية فارغة لطبع النتائج بها في العمود lr2 = .Cells(Rows.Count, 11).End(xlUp).Row + 1 'حلقة تكرارية في الصفوف ابتداءً من الصف الثالث وحتى آخر صف به بيانات ، مع التخطي 6 خطوات For i = 3 To lr Step 6 'إذا كانت الخلية التي يظهر بها الثمن ليست فارغة وأكبر من واحد If .Cells(i + 2, y).Value <> "" And .Cells(i + 2, y) > 1 Then 'تساوي أسماء الأصناف في صفوف الأصناف[K]الخلايا في العمود .Cells(lr2, 11).Value = .Cells(i, y).Value 'تساوي الكميات في صفوف الكمية[L]الخلايا في العمود .Cells(lr2, 12).Value = .Cells(i + 1, y).Value 'تساوي الأسعار في صفوف الثمن[M]الخلايا في العمود .Cells(lr2, 13).Value = .Cells(i + 2, y).Value 'زيادة المتغير بقيمة واحد للانتقال إلى خلية فارغة جاهزة لطبع النتائج بها lr2 = lr2 + 1 'إذا لم يتحقق الشرط Else 'يبقى المتغير بنفس القيمة بدون زيادة lr2 = lr2 End If Next i Next y End With 'إعادة تفعيل خاصية إهتزاز الشاشة Application.ScreenUpdating = True End Sub أرجو أن يكون الشرح واضح وصريح ومش محتاج توضيح الحلقات التكرارية المتشابكة أو المتداخلة دي لا يتقنها إلا محترف مثل ابن مصر سلمت يمناك يا ابن مصر

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

أخي الحبيب إبراهيم هل لديك أكثر من هارد على الجهاز الذي تحدث فيه المشكلة ؟ إذا كان الأمر كذلك جرب أن تعامل المعادلة كمعادلة صفيف ... أو جرب تفعيل هذه المكتبات من قائمة Tools في محرر الأكواد أو جرب هذه الدالة بدلا من الدالة المرفقة في مشاركتك Function HdNum() As String Dim fsObj As Object Dim drv As Object Set fsObj = CreateObject("Scripting.FileSystemObject") Set drv = fsObj.Drives("C") HdNum = Hex(drv.SerialNumber) End Function

الاخ الفاضل أكرم لإنشاء مجلد باسم Test مثلا على البارتشن C قم بتطبيق هذا الكود يمكنك تغيير اسم المجلد أو المسار كما تحب Sub Test() If Len(Dir("C:\Test", vbDirectory)) = 0 Then MkDir "C:\Test" End If End Sub

وهذا حل آخر بالمعادلات بنفس الفكرة توزيع المبالغ حسب الفئات.rar

أخي جمال تفضل الملف المرفق توزيع المبالغ حسب الفئات.rar

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

الحمد لله الذي بنعمته تتم الصالحات

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

أخي الحبيب أخي في الله أخي الغالي عماد الحسامي (شفت القافية دي : غالي وحسامي ).. والله الذي لا إله إلا هو .. والله الذي لا إله إلا هو .. والله الذي لا إله إلا هو ..أفتقدك بشدة ، ودائما ببالي ولم تغيب عن بالي ، وسألت عليك الأستاذ يحيى حسين ، وطمني عليك فينك يا حبيب !!؟؟؟!!!! ليه الغيبة الطويلة دي ... الحمد لله إني اطمنت عليك ..عايزينك معانا يا كبير ..مفتقدينك والله تقبل تحياتي وودي وأشواقي وحبي في الله