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

وهذه فكرتى المتواضعة من خلال وظيفة داخل وحدة نمطية Function GoExt(strText As String) Dim strExtractionWord As String: strExtractionWord = Nz(Left([strText], InStr([strText] & "", " ") - 1), strText) Select Case strExtractionWord Case Is = strText: GoExt = strText Case Is = "مصر": GoExt = "جهورية" & " " & strText Case Is = "العربية": GoExt = "المملكة" & " " & strText Case Is = "المتحدة": GoExt = "الولايات" & " " & strText Case Is = "الاردنية": GoExt = "المملكة العربية" & " " & strText End Select End Function يتم استدعاء الوظيفة من خلال GoExt([text1]) ولا انصح بكتابة الأحرف العربية داخل محرر الاكود ممكن نستخدم اليونيكود او جدول واستخدام DLookup ويكون التطبيق كالاتى db2_text.mdb

شاهد المرفق اخي لا شئ يصعب علي ال VBA جلب البيانات على ختيار رؤوس الاعمده.xlsm

شاهد المرفق اخي xl.rar

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته يسرني اليوم أن أقدم لكم هذه الهدية الرمضانية المتميزة والرائعة 😊 ( الكاتب الذكي لدوال المجال في أكسس ) Dloockup, DCount, DMax, DMin, Dfirst, DLast , DSum, DAvg هذه الأسطورة هي عبارة عن أداة صممتها في أكسس ( بفضل الله وحمده ) تقوم بكتابة دوال المجال نيابة عنك بشكل آلي .. وتعطيك النتيجة بشكل مباشر 😉👌🏼 لن يخطيء أحد بعد اليوم في كتابة جملة هذه الدوال إن شاء الله 😁 كل ما عليك فعله هو استيراد هذه الأداة لبرنامجك ثم اختيار الجدول أو الاستعلام المطلوب والحقل المراد وبعدها سترى العجب العجاب 🙂 ✨ ومن مزاياها :✨ 1 - تسهل عليك كتابة أسماء الجداول والحقول ( فقط تختارها من القائمة المنسدلة ) . 2- يحل مشكلة تداخل النصوص عند استخدامها مع الجداول والحقول المكتوبة باللغة العربية . 3- تفحص لك النتيجة مباشرة للتأكد من أنك ستحصل على البيانات التي تريدها . 4 - سهلة الاستخدام فقط اتبع الخطوات الموضحة وتأكد من اختيار نوع البيانات الصحيح . 5 - يمكنك عمل دالة بأربعة 4 معايير بكل سهولة ويسر . 6 - يمكنك عمل تعديلاتك الخاصة على الدالة مباشرة وفحص النتيجة مباشرة بعد التعديل على النتيجة النهائية . 7 - إمكانية الحصول على الصيغة الخاصة بمحرر الأكواد VBA أو الصيغة المستخدمة في الاستعلامات ومنشيء التعبير . 8- إمكانية استخدام الأداة بشكل مستقل من غير الحاجة لنقلها إلى برنامجك . 9- وغيرها الكثير مما سيفتح الله عليكم اكتشافه بأنفسكم إن شاء الله 😅 طريقة الاستخدام : سهلة يسيرة بحمد الله .. فقط قم بسحب النموذج المسمى SmartDomainFunctionsBuilder_F إلى برنامجك عن طريق السحب والإفلات .. ثم قم بفتح النموذج عندك وسوف يقوم هو آليا بالتعرف على الجداول والاستعلامات الخاصة ببرنامجك بدون الحاجة إلى جهد يذكر 🙂 ( مع إمكانية استخدام الأداة بشكل مستقل من غير الحاجة لنقلها لبرنامجك ولكنك ستفقد الكثير من المميزات 😉 ) الأداة تم عمل الكثير من التجارب عليها وتم تلافي العديد من الأخطاء وإصلاحها بحمد الله وفضله... ولكن لا زلت لا أستغني عن آراءكم وملاحظاتكم من خلال استخدامكم لها 😉 الشرح بالتفصيل : 🙂 وهنا قمت بشرح الأداة بشكل مفصل نوعا ما في مقطع فيديو مدته نصف ساعة تقريبا : وأخيرا التحميل 😊 تحميل الملف الأصلي : >> حمل من هنا آخر إصدار للأداة << تحميل الملف بلمسات المهندس العزيز @د.كاف يار : د.كاف يار __Domain Functions Builder V1.0.accdb وأهم من الأداة نفسها 😉 لا تنسوني من صالح دعائكم لي ولوالدي .. ولا تحرموني من آرائكم ومقترحاتكم ونصحكم وإرشادكم 🙂 أخوكم ومحبكم موسى الكلباني 😊 ‏‏Domain Functions Builder V1.0.accdb

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

اتفضل db2_text (2).mdb

جرب هذا التعديل على الكود الخاص بالاستاذ @عمر ضاحى Dim i As Integer DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Me.text1 Like "*" & "مصر" & "*" Then Me.text2 = "جمهورية مصر العربيه" ElseIf Me.text1 Like "*" & "السعودية" & "*" Then Me.text2 = "المملكة العربيه السعودية" ElseIf Me.text1 Like "*" & "الامريكية" & "*" Then Me.text2 = "الولايات المتحده الامريكيه" ElseIf Me.text1 Like "*" & "الاردنية" & "*" Then Me.text2 = "المملكة العربيه الهاشمية" End If DoCmd.GoToRecord , , acNext If NewRecord Then Exit Sub GoTo nxfor DoCmd.GoToRecord , , acNext nxfor: Next i

Dim i As Integer DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Me.text1 Like "*" & "مصر" & "*" Then Me.text2 = "جمهورية مصر العربيه" ElseIf Me.text1 Like "*" & "السعودية" & "*" Then Me.text2 = "المملكة العربيه السعودية" ElseIf Me.text1 Like "*" & "الامريكية" & "*" Then Me.text2 = "الولايات المتحده الامريكيه" ElseIf Me.text1 Like "*" & "الاردنية" & "*" Then Me.text2 = "المملكة العربيه الهاشمية" End If DoCmd.GoToRecord , , acNext GoTo nxfor DoCmd.GoToRecord , , acNext nxfor: Next i جرب هذا الحل كده

ممكن طبعا باستخدام دالة like Like "*" & "مدير" & "*" هنا هيجيب اى حاجه فيها كلمة مدير 123.rar

ممكن تشوف الشرح هذا عمل بسيط لشرح الفكره

شاهد المرفق اخي 5555.xls

السلام عليكم ورحمة الله استخدم هذا الكود Sub UniqData() Dim ws As Worksheet, sh As Worksheet, C As Range Set ws = Sheets("1") Set sh = Sheets("2") Dim obj As Scripting.dictionary Set obj = New Scripting.dictionary For Each C In ws.Range("C3:C" & ws.Range("C" & Rows.Count).End(3).Row) obj(C & "") = "" Next sh.Range("B4").Resize(obj.Count) = Application.Transpose(obj.keys) End Sub

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

بارك الله فيك اخى موسى مجهود اكثر من رائع , سأجربها فى اقرب وقت ممكن سلمت يداك ولا تحرمنا من الافكار القيمة

شكرا لك اخي العزيز

بعد الرجوع لهذه المشاركه بالذات وكما قلت لك فيجب الرجوع لاول حاجه قمت لك بها والا الامر يحتاج توضيح اكثر بارك الله فيك لانه ردك الاخير تشتييت للامور كلها بجانب كيف تريدها بصف واحد وعلى اى اساس ثم ان ناتج المرفقه بالصوره الاخيره لك 88 غير صحيح والصحيح 352 DateDiff("ww", #1/1/2015#, #10/1/2021#) بصراحه الامور اتلخبطت معايا واعذرنى لقله فهمى لعل احد اخواننا واساتذتنا يفهم المطلوب بشكل اوضح ويفيدك بما تريد باذن الله بالتوفيق اخى محمد

الله الله الله .. جمال في جمال ماشاء الله .. 😃🌹 رائعة من روائعك أخي عمر .. 🙂 أحييت فينا ذكريات الواجهات الجميلة والجذابة في هذه الأيام المباركة 😊 عمل جميل وجهد واضح ماشاء الله 👍🏼

اين المرفق ؟ وهل يمكن شرح لنا الملف يعنى علاقة الجداول ببعض ؟

لكي تعم الفائدة حل للاستاذ ياسر

وعليكم السلام-تفضل تم عمل قائمة منسدلة بأرقام الجلوس وبناءاً على اختيارك منها سيتم جلب بيانات الشهادات شهادات ,والراسبين 4 تعريق 1متغيرات.xlsm

وعليكم السلام -نعم يمكن ذلك بهذا الكود Sub Splitbook() Dim xPath As String xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each xWs In ThisWorkbook.Sheets xWs.Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx" Application.ActiveWorkbook.Close False Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub أو كان عليك من البداية استخدام خاصية البحث بالمنتدى قبل طرح مشاركتك فبها طلبك كيفية فصل الشيتات الموجودة داخل الملف إلى ملفات منفصلة الملف به اربع صفحات.xlsm

😅 انا قلت ممكن نلاقى حل لهذا برضه ^_^

جرب المرفق الذى وضعته بالمشاركة التى قبلك .

بسم الله ما شاء الله وربنا يكرمك على المجهود بس من الممكن انك تبعت رسائل من غير برنامج ملحق او باتش او اى مساعدة خارجية ولا يحتاج مكتبات ويعمل على النسختين 32 , 64 WhatsappMessageSender.accdb قمت بالتعديل على البرنامج الخاص بك لتوضيح الفكره ومن الممكن تجربتها ملحوظة هامة : عند الارسال لأول مره اول مرع على الاطلاق اضغط على زر Alt + Tap ستجد رسالة بها Allow و Not Allow وباعلاها علامه صح امسح الصح من على التشيك بوكس واضغط Allow ولن تظهر ثانيه وسيتم الارسال ورا بعض بدون ادني مشكلة . وبرجاء اخذها سكرين شوت ووضعها بالمشاركات لتعم الفائدة للجميع . ملحوظة اخري : سواء بالطريقة التى تفضلت بوضعها او التى انا قمت بوضعها اذا كان رقم الموبايل جديد او ارضي بياخد باند ولتفادى المشكلة يجب رفع زمن الانتظار بين الرسائل الى 16 ثانية بحد ادني والحد الاقصي لارسال رسائل من اى رقم قديم ان لا تتعدي 45 رسالة بالدقيقة . ملحوظة اخري : غير مشترط وضع اسم الشخص ولكن يجب ان يبدأ رقم الموبايل بكود الدولة .

ابشروا تبقى قليل للدورة لعمل تطبيق مربوط بالاكسس وعرض التقارير والمعلومات الاساسية به .

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