نجوم المشاركات

ربما لم تنتبه للكود اذا اردت الاشتغال على ورقة 2 قم بتعديل هذا السطر لان البيانات يتم جلبها من ورقة 1 Set WS = Worksheets("Sheet1"): Set desWS = Worksheets("Sheet2") الى Set WS = Worksheets("Sheet2"): Set desWS = Worksheets("Sheet2") او تعديله بالكامل بالشكل التالي Option Explicit Public Sub TransposeData2() Dim desWS As Worksheet, rng As Variant Dim Cpt() As Variant, I As Long, J As Long, k As Long, loc As String Set desWS = Worksheets("Sheet2") Application.ScreenUpdating = False rng = desWS.[C6:O10].Value2 For I = 2 To UBound(rng) For J = 2 To UBound(rng, 2) Step 2 If rng(I, J) > 0 Then ReDim Preserve Cpt(2, k + 1) Cpt(0, k) = rng(I, 1) Cpt(1, k) = rng(I, J) k = k + 1 End If Next J Next I If k > 0 Then desWS.Range("C15:D" & Rows.Count).ClearContents desWS.Cells(15, 3).Resize(k, 2).Value = Application.Transpose(Cpt) 'اظافة الجدول loc = desWS.Range("C14:D" & desWS.[D65000].End(xlUp).Row).Address If desWS.ListObjects.Count <> 0 Then Exit Sub desWS.Cells(14, 3).Resize(, 2).Value = Array("Part", "INDEX") desWS.ListObjects.Add(xlSrcRange, desWS.Range(loc), , xlYes).Name = _ "Table1" End If Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) اليوم جئتكم ببرنامج المنبه الذكي هدية بسيطة لأعضاء منتدانا الغالي وصف البرنامج :- إمكانية تغيير الثيم من داخل الساعة . إمكانية تغيير نغمة رنين المنبه . نغمة تنبيه كل ساعة . دعم للغفوة كما في أجهزة الموبايل . إمكانية تعديل مدة العفوة حسب الحاجة . إمكانية عمل تنبيه متكرر حسب اليوم ، أو التنبيه لأيام محددة . صور من المنبه الذكي :- عند فتح المنبه لأول مرة لوحة التحكم بالإعدادات واجهة المنبه شاشة وقت التنبيه شاشة ضبط المنبه شاشة عرض المنبهات الفعالة والآن مع التحميل بدايةً النسخة 64 ، وقريباً النسخة الثانية بإصدار 32 إن شاء الله :- 64.zip ملاحظة:- تم حفظ البرنامج بصيغة Accde كونه قيد التطوير والتعديل حالياً وعدناكم بإضافة جديدة وهي إضافة حالة الطقس في شاشة المنبه الذكي ، والحمد لله الذي قدرني على توظيف هذه الميزة داخل التطبيق . وكما ذكرت سابقاً الخدمة تحتاج إتصال إنترنت . من الإعدادات > قم باختيار البلد > ثم تطبيق . وسيتم الإتصال بالسيرفر تلقائياً وإدراج درجة الحرارة في شاشة المنبه الرئيسية . ملاحظة :- درجة الحرارة التي يتم عرضها حالياً هي للعواصم العربية فقط ، وسيتم العمل على إدراج معظم المدن في الدول العربية في تحديثات لاحقة . الملف مفتوح المصدر ، وأطلب منكم فقط الدعاء لوالديّ Smart Alarm.zip وباب الحوار مفتوح للمناقشة

اشكركم جميعاً اساتذتمى الكرام وجعل الله علمكم فى ميزان حسناتكم

تسلم اخي foksh علي ردك وسعة صدرك وسامحني علي الازعاج وشكرا لك

عندك شرط Is Null في الاستعلام مصدر بيانات التقرير . وعدي الجملة في الايتعلام ألى التالي :- <> "Approved" and <> "Closed"

هو المطلوب بارك الله فيك اخى @abouelhassan سلمت يداك وجعله الله فى ميزان حسناتك

تفضل abouelhassan.xls

🤗

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

انا نفذت الموجود بالملف المرفق

جزاكم الله خيراً تسلم ايديك والشكر موصول للأستاذ أبو إيمان

تفضل طلبك abouelhassan.xlsm

تفضل ............................... مستندات.accdb

أحييك على الجماليات والفنيات والألوان المبهرات باش مهندس @Foksh 👍🙂 ملاحظات بسيطة 😁 : عند الضغط على اسم البرنامج في شريط الوندوز تظهر شاشة البرنامج الرمادية 🙂 عند الضغط على [غفوة] تظهر رسالة الاستعلام ( أقترح لو تخفيها ) ظهورها مزعج 🙂 عند حذف أحد المنبهات تظل الصفحة ويطلع التالي : بعد الضغط على زر الإغلاق يظل الأكسس شغال في الخلفية 🙂 بالنسبة لنغمة المنبه أقترح تعمل قائمة منسدلة للاختيار من الأصوات المرفقة مع النظام ، وزر لاستعراض الملفات لو حب المستخدم يضيف الملف الصوتي من عنده 🙂 + لون النصوص حبذل لو يكون رمادي فاتح لما تكون الخلفية سوداء لتسهل قرائتها 🙂 هذا وتقبل تحياتي 😊🌹

وعليكم السلام ورحمة الله تعالى وبركاته لم افهم مادا تقصد بتصفية البيانات في جدول منفصل لاكن على العموم للحصول على النتيجة الظاهرة في الصورة اعلى يكيفي استخدام الكود التالي Option Explicit Public Sub TransposeData() Dim Cpt() As Variant, I As Long, J As Long, k As Long, rng As Variant Dim WS As Worksheet: Set WS = Worksheets("Sheet1") Application.ScreenUpdating = False rng = WS.[C6:O10].Value2 For I = 2 To UBound(rng) For J = 2 To UBound(rng, 2) Step 2 If rng(I, J) > 0 Then ReDim Preserve Cpt(2, k + 1) Cpt(0, k) = rng(I, 1) Cpt(1, k) = rng(I, J) k = k + 1 End If Next J Next I If k > 0 Then WS.Range("C15:D" & Rows.Count).ClearContents WS.Cells(15, 3).Resize(k, 2).Value = Application.Transpose(Cpt) End If Application.ScreenUpdating = True End Sub ولوضعها في جدول يمكنك التعديل على الكود على الشكل التالي هدا مثال لنسخ البيانات على ورقة 2 Option Explicit Public Sub TransposeData2() Dim WS As Worksheet, desWS As Worksheet, rng As Variant Dim Cpt() As Variant, I As Long, J As Long, k As Long, loc As String Set WS = Worksheets("Sheet1"): Set desWS = Worksheets("Sheet2") Application.ScreenUpdating = False rng = WS.[C6:O10].Value2 For I = 2 To UBound(rng) For J = 2 To UBound(rng, 2) Step 2 If rng(I, J) > 0 Then ReDim Preserve Cpt(2, k + 1) Cpt(0, k) = rng(I, 1) Cpt(1, k) = rng(I, J) k = k + 1 End If Next J Next I If k > 0 Then desWS.Range("C15:D" & Rows.Count).ClearContents desWS.Cells(15, 3).Resize(k, 2).Value = Application.Transpose(Cpt) 'اظافة الجدول loc = desWS.Range("C14:D" & desWS.[D65000].End(xlUp).Row).Address If desWS.ListObjects.Count <> 0 Then Exit Sub desWS.Cells(14, 3).Resize(, 2).Value = Array("Part", "INDEX") desWS.ListObjects.Add(xlSrcRange, desWS.Range(loc), , xlYes).Name = _ "Table1" End If Application.ScreenUpdating = True End Sub تصفية تلقائية V2.xlsb

بناءً على الأفكار اللامعة للأستاذ @Moosak :- تم إضافة تشغيل البرنامج عند تشغيل الويندوز ( تمت التجربة على الإصدارات Windows 10 & Windows 7 & Windows XP ) . تم إضافة زر التصغير Minimize . تم تحديث شكل بعض الأزرار . تحديث بعض الأخطاء البرمجية . ⏱️ ملاحظة ، عند تشغيل البرنامج لأول مرة ، يجب اختيار الثيم ، ونغمة التنبيه من مجلد Notification من خلال الضغط على صورة الجرس . جاري العمل على إضافة عرض درجة الحرارة لواجهة المنبه حسب البلد أو المدينة ( يلزم إتصال إنترنت )

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