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

السلام عليكم كود طباعة وكود تحويل pdf Sub Print_Managers_Deputies() Dim wsData As Worksheet, wsReport As Worksheet Dim lastRow As Long, i As Long Dim idVal As String, roleVal As String Application.ScreenUpdating = False Application.EnableEvents = False Set wsData = ThisWorkbook.Sheets("data") Set wsReport = ThisWorkbook.Sheets("التقرير مدير وكيل") lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row For i = 3 To lastRow idVal = wsData.Cells(i, "A").Value roleVal = wsData.Cells(i, "E").Value If (InStr(1, roleVal, "مدير", vbTextCompare) > 0) _ Or (InStr(1, roleVal, "وكيل", vbTextCompare) > 0) Then wsReport.Range("L2").Value = idVal wsReport.PrintOut wsReport.Range("L2").Value = 1 End If Next i MsgBox "تمت طباعة جميع المديرين والوكلاء.", vbInformation Application.ScreenUpdating = True Application.EnableEvents = True End Sub Sub sav_PDFall2() Dim wsData As Worksheet, wsReport As Worksheet Dim lastRow As Long, i As Long Dim roleVal As String Dim folderPath As String, pdfPath As String Dim safeName As String Application.ScreenUpdating = False Application.EnableEvents = False Set wsData = ThisWorkbook.Sheets("data") Set wsReport = ThisWorkbook.Sheets("التقرير مدير وكيل") wsReport.Unprotect password:="0" folderPath = ThisWorkbook.Path & "\التقرير مدير وكيل" If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row For i = 3 To lastRow roleVal = wsData.Cells(i, "E").Value If (InStr(1, roleVal, "مدير", vbTextCompare) > 0) _ Or (InStr(1, roleVal, "وكيل", vbTextCompare) > 0) Then wsReport.Range("C9").Value = wsData.Cells(i, "B").Value safeName = wsReport.Range("C9").Value safeName = Replace(safeName, "/", "-") safeName = Replace(safeName, "\", "-") safeName = Replace(safeName, ":", "-") safeName = Replace(safeName, "*", "-") safeName = Replace(safeName, "?", "-") safeName = Replace(safeName, """", "-") safeName = Replace(safeName, "<", "-") safeName = Replace(safeName, ">", "-") safeName = Replace(safeName, "|", "-") pdfPath = folderPath & "\" & safeName & ".pdf" wsReport.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=pdfPath, _ Quality:=xlQualityMinimum, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End If Next i MsgBox "تم حفظ جميع ملفات PDF للمديرين والوكلاء في:" & vbCrLf & folderPath, vbInformation wsReport.Protect password:="0" Application.ScreenUpdating = True Application.EnableEvents = True End Sub الملف طباعة وظائف محددة.xlsm

في هذه المشاركة سأحاول أن اشارك حضراتكم بعض المحاضرات و الدروس التي يلقيها خبراء عالميين في مجال الاكسيس المحاضرة الاولى : Access Add-in Helper with Geoffrey L. Griffith أولا تعريف : ADD In Microsoft Access Add-in هو برنامج إضافي (Plug-in أو Extension) يتم تثبيته داخل Microsoft Access لإضافة وظائف أو أدوات جديدة غير موجودة بشكل افتراضي في البرنامج. 🔹 بمعنى آخر: الـ Add-in عبارة عن موديول أو ملف برمجي (عادةً يكون مكتوب بلغة VBA أو VB6 أو .NET) يندمج مع واجهة Access ويضيف لك قوائم أو أزرار أو أوامر خاصة تساعدك على تنفيذ مهام متكررة أو متقدمة بسهولة. 🔹 أمثلة على ما يقدمه الـ Add-in: أدوات لتسريع كتابة الأكواد (Code Libraries). قوالب جاهزة للتقارير أو النماذج. أزرار إضافية على الـ Ribbon أو الـ Menu bar. وظائف جاهزة لتحليل البيانات أو إصلاح قواعد البيانات. 🔹 مكانها في Access: تظهر عادة في قائمة Add-ins داخل الـ Ribbon. يمكن تشغيلها مثل أي أداة مدمجة في Access. 🔹 أشكال الـ Add-in: ملف .MDA أو .ACCDA (قديماً MDE/ACCDE). ممكن يتوزع مع البرنامج أو تثبته بشكل مستقل. ثانيا: ملخص الفيديو أداة جيفري المساعدة للوظائف الإضافية في Access (Access Add-in Helper) قدم جيفري أداة قام بإنشائها لمساعدة المستخدمين على إنشاء وتوزيع وظائفهم الإضافية الخاصة. كان دافعه لإنشاء هذه الأداة هو الصعوبة التي واجهها شخصيًا في تذكر جميع الخطوات اللازمة لإنشاء وظيفة إضافية. لذلك، قرر إنشاء تطبيق مستقل يقوم بأتمتة هذه العملية لتجنب الأخطاء. ستكون الأداة متاحة مجانًا على منصة GitHub قريبًا. الميزات الرئيسية للأداة المساعدة: عملية مؤتمتة: تأخذ الأداة المستخدم عبر خطوات إرشادية لإنشاء وتوزيع الوظائف الإضافية. قابلة للتخصيص: يمكن تخصيص الإعدادات، والتي تشمل أسماء المشاريع، ونماذج بدء التشغيل، وإعدادات التطبيق، وخصائص قاعدة البيانات. كتالوج للوظائف الإضافية: تحتوي الأداة على كتالوج للوظائف الإضافية المجانية المتاحة للتنزيل، ويخطط جيفري لتحديثه بمساهمات من المجتمع. سهولة الاستخدام: يمكن للمستخدمين فتح دليل الوظائف الإضافية وعرض سجلات الأخطاء بسهولة. أيقونة مُولَّدة بالذكاء الاصطناعي: تتميز الأداة بأيقونة فريدة تم إنشاؤها بواسطة الذكاء الاصطناعي. محرر خصائص قاعدة البيانات (Database Property Editor) تم استلهام هذه الأداة من اقتراح قدمه "جورج" في اجتماع سابق. وهي تتيح للمستخدمين عرض خصائص قاعدة البيانات وتعديلها وحذفها. الميزات الرئيسية لمحرر الخصائص: إدارة الخصائص: يمكن للمستخدمين إضافة الخصائص أو تعديلها أو حذفها. تعرض الأداة فهرس الخاصية ونوعها وقيمتها. أنواع البيانات: تتضمن قائمة بأنواع بيانات DAO (Data Access Objects) القابلة للتعيين. سهلة الاستخدام: تم تصميم الأداة لتكون بسيطة وسهلة الاستخدام. النقاش والأسئلة والأجوبة مجموعات الخصائص (Property Collections😞 سأل "جون" عن مجموعات الخصائص المختلفة في Access. أوضح جيفري أن أداته تركز حاليًا على الخصائص على مستوى قاعدة البيانات، ولكنه قد يوسع وظائفها في المستقبل. مفتوحة المصدر: ستكون الأداة مفتوحة المصدر، مما يسمح للمجتمع بالمساهمة في تطويرها. الخصائص المخفية: ناقش الحاضرون الخصائص المخفية المتنوعة في Access. وأشار "جورج" إلى أن بعض هذه الخصائص، مثل خيار استخدام محرر Monaco، يمكن تفعيلها. تخزين البيانات في الخصائص: ناقش الحاضرون إيجابيات وسلبيات تخزين البيانات في مجموعات الخصائص مقابل استخدام جدول مخصص للإعدادات، حيث يفضل جيفري استخدام جدول الإعدادات. تصحيح الأخطاء المباشر: عمل الحاضرون معًا للعثور على خطأ برمجي في أداة "محرر الخصائص" وإصلاحه خلال الاجتماع. تثبيت الوظائف الإضافية: سأل "براين" عن تحديات تعديل وتحديث الوظائف الإضافية، خاصة مع تحديثات Office 365 المتكررة التي قد تزيلها. ناقش الحاضرون حلولاً لذلك، مثل استخدام كائن مساحة العمل (workspace object) لفتح وتعديل الوظيفة الإضافية. ثالثا : ملف حوار الاجتماع مرفق باللغة الإنجليزية تجدونه في المرفقات ان شاء الله . و يمكن بسهولة يتم ترجمته من خلال ChatGpt AP; Microsoft Access Add-in Helper with Geoffrey L. Griffith (English_ASR).rar

في طلبك الاول TextBox8 فقط والان تغير الطلب الى الكمبوبكس يمكن اظافة التالي الى UserForm_Initialize Dim ctrl As Control For Each ctrl In Me.Controls If TypeName(ctrl) = "ComboBox" Then ctrl.Style = fmStyleDropDownList ctrl.Locked = False End If Next ctrl برنامج المراكز الطبية 30 اغسطس.xlsm

السلام عليكم اليك الملف المرشحين1.xlsb

السلام عليكم ورحمة الله وبركاته الكود Sub CheckAbsence() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim countConsecutive As Long, maxConsecutive As Long Dim countTotal As Long Dim msg As String Dim cell As Range Set ws = ThisWorkbook.Sheets("ورقة1") lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row For i = 2 To lastRow countConsecutive = 0 maxConsecutive = 0 countTotal = 0 ' المرور على نطاق الغياب C:AG For Each cell In ws.Range("C" & i & ":AG" & i) If cell.Value = "غ" Then countConsecutive = countConsecutive + 1 countTotal = countTotal + 1 If countConsecutive > maxConsecutive Then maxConsecutive = countConsecutive End If Else countConsecutive = 0 End If Next cell msg = "" If maxConsecutive >= 15 Then msg = "مفصول" ElseIf maxConsecutive >= 5 Then msg = "إنذار أول" End If If countTotal >= 30 Then msg = "مفصول" ElseIf countTotal >= 24 Then msg = "إنذار ثالث" ElseIf countTotal >= 16 Then msg = "إنذار ثاني" ElseIf countTotal >= 8 And msg = "" Then msg = "إنذار أول" End If ws.Cells(i, "AH").Value = msg Next i End Sub الملف سجل غياب الطلاب1.xlsb

وعليكم السلام ورحمة الله وبركاته تم انشاء كود الطباعة والمعاينة اتمنى ان تجد في الحل طلبك لك وافر الاحترام Sub Print_All_Employees() Dim ws As Worksheet Dim cell As Range Dim rng As Range Set ws = ThisWorkbook.Sheets("إداريين") Set rng = ws.Range("C3:C137") Application.ScreenUpdating = False For Each cell In rng If cell.Value <> "" Then ws.Range("CQ6").Value = cell.Value ws.PageSetup.PrintArea = "CP5:CY47" ws.PrintOut End If Next cell ws.Range("CQ6").Value = rng.Cells(1, 1).Value Application.ScreenUpdating = True MsgBox "تمت طباعة جميع الموظفين بنجاح.", vbInformation End Sub طباعة الكل بضغطة.xlsm

استخدم هذا المعيار : Like "*" & "[#]" & "*" لأن # من احرف البدل لذا يجب احاطته بقوسين مربعين لتمييزه

بارك الله فيك أستاذ أحمد . كما تفضلت حضرتك بالملف فإن معادلة العلامة خبور رائعة و تصلح لهذا الملف تماما فقط قم بنسخ الكود التالي في موديل جديد في في محرر الأكواد Function kh_Names(FullName As String, ParamArray iNdex1()) As String Dim i As Integer Dim kh_Split, MyArray, Ar Dim Kh_String As String, Sn As String, Re As String On Error GoTo Err_Kh_Names '====================================== MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _ , " الله", " الدين", " الإسلام", " الاسلام", " الحق") '====================================== Sn = Application.WorksheetFunction.Trim(FullName) For Each Ar In MyArray Re = Replace(Ar, " ", "^") Sn = Replace(Sn, Ar, Re) Next '====================================== kh_Split = Split(Sn, " ", , vbTextCompare) On Error Resume Next For i = 0 To UBound(iNdex1) Kh_String = Kh_String & " " & kh_Split(iNdex1(i) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") kh_Names = Kh_String Exit Function Err_Kh_Names: kh_Names = "" End Function ثم ضع المعادلة التالية في خانة اسم الأب مثلا: =kh_Names(H9;2;3;4;5) مع مراعاة الفاصلة عادية أو منقوطة حسب اصدار الاوفيس مجمع 2026بعد نتيجة ثالثة.xlsm

Try the file كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار.xlsm

و عليكم السلام ورحمة الله وبركاته تفضل الملف و يمكن اختيار الفصل من القائمة المنسدلة لعمل التصفية لازم نشير أن الملف الأصلي من اعداد الدكتور أحمد البحراوي جديد 5 سلوك (2).xlsm

الملخص: ملخص تفصيلي: تحويل MS Access إلى عميل ويب حديث عبر APIs تستكشف هذه المحاضرة التحول النموذجي في كيفية استخدام Microsoft Access، حيث ننتقل به من كونه مجرد واجهة لقواعد البيانات المرتبطة (Linked Tables) إلى كونه عميل تطبيق ديناميكي (Dynamic Application Client) يتفاعل مباشرة مع خدمات الويب الحديثة عبر واجهات برمجة التطبيقات (APIs). هذا النهج يفتح آفاقاً جديدة لـ Access ليتكامل مع أي نظام تقريباً على الإنترنت. 1. المفهوم الجوهري: فصل الواجهة عن البيانات (Decoupling) الفكرة الأساسية هي فك الارتباط بين واجهة المستخدم الأمامية (Front-end) التي يصممها المطور في Access، وقاعدة البيانات الخلفية (Back-end). النموذج التقليدي: يقوم Access بالاتصال مباشرة بقاعدة بيانات (مثل SQL Server) عبر ODBC. هذا يعني أن Access يجب أن يعرف مكان الخادم، وتفاصيل الاتصال، ولديه صلاحيات مباشرة على الجداول. هذا الارتباط قوي ومباشر. نموذج الـ API الحديث: يعمل الـ API كوسيط أو "مترجم". تطبيق Access لا يتحدث مباشرة مع قاعدة البيانات، بل يرسل طلبات HTTP معيارية (مثل GET, POST) إلى عنوان URL خاص بالـ API. الـ API بدوره هو المسؤول عن التحدث مع قاعدة البيانات، وتنفيذ الطلب، ثم إعادة النتيجة إلى Access. الميزة الكبرى لهذا الفصل: يمكن تغيير قاعدة البيانات الخلفية بالكامل (مثلاً من SQL Server إلى Oracle أو حتى قاعدة بيانات NoSQL مثل MongoDB) دون الحاجة إلى تغيير سطر واحد في كود Access، طالما أن "عقد" الـ API (عناوين URL وشكل البيانات) لم يتغير. هذا يمنح النظام مرونة وصيانة أسهل وقابلية للتطوير. 2. الأدوات التقنية المستخدمة بالتفصيل 🛠️ لتحقيق هذا التكامل، تم الاعتماد على حزمة من التقنيات التي تعمل معاً بسلاسة داخل بيئة VBA. مكتبة VBA-Web هذه هي المحرك الرئيسي للعملية. هي مجموعة من كائنات VBA (Classes) تغلف التعقيدات المتعلقة ببروتوكول HTTP. أهم كائناتها: WebClient: الكائن الأساسي الذي يحتفظ بعنوان URL الرئيسي للـ API (مثال: https://api.weather.com). WebRequest: يمثل الطلب الفردي. من خلاله نحدد: المورد (Resource): المسار الفرعي داخل الـ API (مثال: forecast). الطريقة (Method): نوع العملية (Get لجلب البيانات، Post لإنشاء بيانات جديدة، Put لتحديث بيانات موجودة، Delete لحذفها). المعلمات (Parameters): البيانات الإضافية التي نرسلها مع الطلب، مثل AddQueryParameter لإضافة متغيرات إلى عنوان URL (مثال: ?city=Cairo&units=metric). الجسم (Body): يستخدم مع طلبات Post و Put لإرسال البيانات الفعلية (عادةً بتنسيق JSON) التي نريد حفظها في قاعدة البيانات. WebResponse: يحتوي على الرد من الخادم. أهم خصائصه: .Data: يحتوي على البيانات المُرجعة (عادةً نص JSON). .StatusCode: رمز الحالة الرقمي الذي يخبرنا بنتيجة الطلب (200 للنجاح، 404 لـ "غير موجود"، 401 لـ "غير مصرح له"، 500 لخطأ في الخادم). تنسيق JSON هو المعيار الفعلي لتبادل البيانات على الويب اليوم. هيكله بسيط ويعتمد على: أزواج المفتاح-القيمة (Key-Value Pairs): مثل {"name": "Ahmed", "age": 30}. الكائنات المتداخلة (Nested Objects): يمكن أن تكون القيمة نفسها كائناً آخر، مثل {"user": {"firstName": "Ali", "lastName": "Hassan"}}. المصفوفات (Arrays): قائمة من القيم، مثل {"skills": ["Access", "SQL", "VBA"]}. كائن الـ Dictionary هذا الكائن، الذي يأتي من مكتبة Microsoft Scripting Runtime، هو المكافئ المثالي لهيكل JSON داخل VBA. إنه يخزن البيانات كأزواج مفتاح-قيمة. مكتبة VBA-Web تقوم تلقائياً بعملية تسمى "التحويل" (Deserialization)، حيث تحول نص JSON القادم من الرد إلى كائن Dictionary متداخل. هذا يجعل الوصول إلى البيانات سهلاً جداً: VBA ' بدلاً من التعامل مع نص معقد ' يمكننا الوصول للبيانات هكذا: Dim temp As Double temp = MyDictionary("current_weather")("temperature") 3. تحليل معمق للأمثلة العملية 📝 مثال الطقس (قراءة البيانات فقط - GET) التهيئة: يتم إنشاء كائن WebClient وتحديد عنوان URL الأساسي لخدمة الطقس. بناء الطلب: يتم إنشاء كائن WebRequest وتحديد المورد (forecast) والطريقة (Get). إضافة المعلمات: يتم استخدام .AddQueryParameter لإضافة خطوط الطول والعرض (التي تم جلبها من جدول Access محلي) إلى الطلب، بالإضافة إلى معلمات أخرى مثل وحدة القياس (فهرنهايت). التنفيذ: يتم استدعاء Client.Execute(Request)، والذي يرسل الطلب وينتظر الرد. معالجة الرد: يتم فحص Response.StatusCode. إذا كان 200، يتم تحويل Response.Data (الذي هو JSON) إلى Dictionary. تعبئة النموذج: يتم الوصول إلى القيم المطلوبة من الـ Dictionary (مثل WeatherData("main")("temp")) وتعيينها مباشرة إلى مربعات النص في نموذج Access. لا يوجد ربط بيانات مباشر؛ العملية تتم برمجياً بشكل كامل. مثال المنتجات (قراءة وكتابة - CRUD Operations) هنا تظهر قوة الـ API الكاملة. تحديث منتج (PUT): عندما يغير المستخدم السعر في النموذج ويضغط "حفظ"، يقرأ كود VBA القيم الجديدة (اسم المنتج، السعر) من حقول النموذج. يتم إنشاء كائن Dictionary جديد في VBA لتمثيل المنتج المحدث. يتم تحويل هذا الـ Dictionary إلى نص JSON باستخدام وظيفة خاصة في مكتبة VBA-Web. يتم إنشاء طلب WebRequest بطريقة Put ويتم إرساله إلى عنوان URL محدد للمنتج (مثال: /api/products/15). يتم تعيين نص JSON الذي تم إنشاؤه إلى خاصية .Body للطلب. عند التنفيذ، يستقبل الـ API الطلب، ويقرأ الجسم، ويقوم بتحديث السجل المقابل في قاعدة بيانات SQL. إضافة منتج جديد (POST): العملية مشابهة جداً للتحديث، ولكن الطلب يُرسل بطريقة Post إلى عنوان URL العام للمنتجات (مثال: /api/products)، ويقوم الـ API بإنشاء سجل جديد بدلاً من تحديث سجل موجود. حذف منتج (DELETE): أبسط عملية. يتم إرسال طلب WebRequest بطريقة Delete إلى عنوان URL الخاص بالمنتج المراد حذفه (مثال: /api/products/15). هذا الطلب لا يحتاج عادةً إلى جسم (Body). 4. استنتاجات ومفاهيم متقدمة 🚀 معالجة الأخطاء: من الضروري دائماً فحص StatusCode. إذا لم يكن 200، يجب على الكود التعامل مع الخطأ بشكل مناسب، كعرض رسالة للمستخدم تشرح المشكلة (مثل "لا يمكن العثور على المنتج" للرمز 404). أداة Postman: تم التأكيد على أهمية استخدام أدوات مثل Postman. تسمح هذه الأداة للمطور باختبار كل طلبات الـ API (GET, POST, etc.) بشكل مستقل عن Access. يمكن للمطور التأكد من أن الطلب يعمل وأن البيانات المرجعة صحيحة قبل كتابة أي كود VBA، مما يوفر ساعات من تصحيح الأخطاء. الأمان والمصادقة: معظم واجهات الـ API الحقيقية ليست مفتوحة للجميع. تتطلب "مفتاح API" أو "رمز مصادقة" (Token) يتم إرساله مع كل طلب. مكتبة VBA-Web تدعم إضافة هذه المعلومات بسهولة إلى رؤوس الطلب (Request Headers) لتأمين الاتصال. في الختام، هذه المحاضرة لم تكن مجرد شرح لتقنية جديدة، بل كانت دعوة لتغيير طريقة التفكير في دور MS Access. فبدلاً من كونه أداة محصورة في بيئة سطح المكتب، يمكن تحويله باستخدام هذه التقنيات إلى مكون مرن وقوي في أي بنية تحتية حديثة تعتمد على الخدمات السحابية والويب. و أخيرا ملف الترجمة الي العربية ملف الترججمة الي العربية.rar

وعليكم السلام ورحمة الله وبركانه حرب الكود بالملف خلاصة حسب تقرير البصمة1.xlsm

شكرا استاذ عبدالله و حاولت أن ابتعد عن الأكواد قدر المستطاع و لم يكن هناك خطأ في الصيغة و لكني استخدمت صيغة XLOOKUP و هي ليست متوفرة في الاصدرات القديمة لذلك قمت بتعديل الصيغة ليعمل الملف على أي اصدار تبادل معلوات ورقتين(2).xlsx تبادل معلوات ورقتين(2).zip

السلام عليكم بعد اذن استاذنا الفاضل hegazee جرب التعديل التالي تبادل معلوات ورقتين(1).xlsb

السلام عليكم جرب التعديل التالي التعديل في الجزء wsArchive.Protect Password:=Password, USERINTERFACEONLY:=True الى wsArchive.Protect Password:=Password, USERINTERFACEONLY:=True, AllowFiltering:=True الكود كاملا Sub CopyPrintClear() Dim wsArchive As Worksheet Dim wsPrint As Worksheet Dim lastRow As Long Dim copyRange As Range Dim rowCount As Long Dim i As Long Dim Password As String Dim requiredCells As Variant Dim cell As Variant Dim isIncomplete As Boolean Password = "KHORSHEED.OMAR.2025" ' تعيين الشيتات Set wsPrint = ThisWorkbook.Sheets("طباعة") Set wsArchive = ThisWorkbook.Sheets("أرشيف") ' التحقق من الخلايا المطلوبة requiredCells = Array("A2", "F2", "F3", "C18") isIncomplete = False For Each cell In requiredCells If Trim(wsPrint.Range(cell).Value) = "" Then isIncomplete = True Exit For End If Next cell If isIncomplete Then MsgBox "الملف غير كامل. يرجى تعبئة جميع الخلايا المطلوبة.", vbExclamation Exit Sub End If ' رسالة تأكيد If MsgBox("هل تريد تنفيذ العملية؟", vbYesNo + vbQuestion, "تأكيد") = vbNo Then Exit Sub End If ' رفع الحماية مؤقتًا wsArchive.Unprotect Password:=Password ' تحديد نطاق النسخ Set copyRange = wsPrint.Range("A6:G15") rowCount = copyRange.Rows.Count ' تحديد أول صف فارغ في شيت الأرشيف lastRow = wsArchive.Cells(wsArchive.Rows.Count, "B").End(xlUp).Row + 1 ' نسخ الجدول بالكامل إلى الأرشيف wsArchive.Range("A" & lastRow).Resize(rowCount, 5).Value = copyRange.Value ' نسخ القيم الفردية إلى الأعمدة المطلوبة wsArchive.Range("F" & lastRow & ":F" & lastRow + rowCount - 1).Value = wsPrint.Range("C18").Value wsArchive.Range("J" & lastRow & ":J" & lastRow + rowCount - 1).Value = wsPrint.Range("B3").Value wsArchive.Range("H" & lastRow & ":H" & lastRow + rowCount - 1).Value = wsPrint.Range("F3").Value wsArchive.Range("G" & lastRow & ":G" & lastRow + rowCount - 1).Value = wsPrint.Range("F2").Value wsArchive.Range("I" & lastRow & ":I" & lastRow + rowCount - 1).Value = wsPrint.Range("A2").Value ' تحديد منطقة الطباعة وشطبها wsPrint.PageSetup.PrintArea = "$A$1:$F$18" wsPrint.PrintOut ' مسح البيانات من الشيت wsPrint.Range("A6:A15").ClearContents wsPrint.Range("C6:E15").ClearContents wsPrint.Range("A2").ClearContents wsPrint.Range("F2").ClearContents wsPrint.Range("F3").ClearContents wsPrint.Range("C18").ClearContents ' الطباعة مرة ثانية إذا رغبت wsPrint.PageSetup.PrintArea = "$A$1:$F$18" wsPrint.PrintOut wsArchive.Protect Password:=Password, USERINTERFACEONLY:=True, AllowFiltering:=True ' تنظيف الحافظة Application.CutCopyMode = False ' العودة إلى شيت الطباعة وتحديد الخلية A1 wsPrint.Activate wsPrint.Range("A1").Select End Sub

هحاول اختصر لك الموضوع اولا القاعدة الخلفية هتغلق بكلمة سر قوية ثانيا القاعدة الامامية هتغلقها بكلمة سر (ممكن تحولها ايضا لقاعدة accde لاضافة طبقة حماية ^_^ ) هتعمل قاعدة اخري لفتح القاعدة الامامية وتكون accde وهي التى ستمرر كلمة السر للقاعدة الامامية وتفتحها هتلاقي مواضيع كثير وطرق كثير فقط ابحث واختر المناسب لك

وعليكم السلام ورخمة الله وبركاته ربما تفصد اخفاء الاعمدة وليس الخذف كما ورد في طلبك الكود يخفى العمود كله فارغ أو كله قيمه تساوي (0 أو 0%) → يخفي العمود بالكامل. الكود في البداية يظهر كل الأعمدة ثم يعيد إخفاء المناسب تم ربط الكود مع امر الفلترة اظافة التسطير لناتج الفلترة هذا خسب فهمى لطلبكم الكود Sub فلترة_اخفاء() Dim wsSrc As Worksheet, wsDst As Worksheet Dim lastRow As Long Dim rng As Range, col As Range, c As Range Dim hideCol As Boolean Dim rngOut As Range Application.ScreenUpdating = False Set wsSrc = ThisWorkbook.Sheets("المجمع") Set wsDst = ThisWorkbook.Sheets("1") lastRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row If lastRow >= 5 Then wsDst.Rows("5:" & lastRow).ClearContents wsDst.Rows("5:" & lastRow).ClearFormats End If wsDst.Columns("A:W").Hidden = False lastRow = wsSrc.Cells(wsSrc.Rows.Count, "E").End(xlUp).Row If lastRow < 2 Then Exit Sub wsSrc.Range("E1:W" & lastRow).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=wsDst.Range("Criteria"), _ CopyToRange:=wsDst.Range("Extract"), _ Unique:=False lastRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row If lastRow < 5 Then GoTo Done Set rngOut = wsDst.Range("A5:W" & lastRow) With rngOut.Borders .LineStyle = xlContinuous .Color = vbBlack .Weight = xlThin End With rngOut.EntireColumn.Hidden = False For Each col In rngOut.Columns hideCol = True For Each c In col.Cells If Not (isEmpty(c.Value) Or c.Value = 0 Or c.Text = "0%") Then hideCol = False Exit For End If Next c If hideCol Then col.EntireColumn.Hidden = True Next col Done: Application.ScreenUpdating = True End Sub الملف W1.xlsm تحياتي

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

وعليكم السلام ورحمة الله وبركاته ,, جرب اكتب اي قيم رقمية وانقر كلمة يساوي test.zip

العفو حبيبنا واستاذنا الكريم للمزيد حول المعلومة : هذا مرجع لحروف البدل في اكسس

محاولتي: معادلة طرح وجمع تاريخين_02.xlsx

و عليكم السلام ورحمة الله و بركاته تفضل =INT((DATEDIF(D13;E13;"y")+DATEDIF(D14;E14;"y")+(DATEDIF(D13;E13;"ym")+DATEDIF(D14;E14;"ym")+(DATEDIF(D13;E13;"md")+DATEDIF(D14;E14;"md"))/30)/12)) & " years; " & MOD(DATEDIF(D13;E13;"ym")+DATEDIF(D14;E14;"ym")+INT((DATEDIF(D13;E13;"md")+DATEDIF(D14;E14;"md"))/30);12) & " months; " & MOD(DATEDIF(D13;E13;"md")+DATEDIF(D14;E14;"md");30) & " days" معادلة طرح وجمع تاريخين 2.xlsx

وعليكم السلام ورحمة الله وبركاته .. مشاركة مع الأساتذة .. جرب SELECT * FROM جدول1 WHERE InStr([INFO COD], "#") > 0;

استخدم دالة IsNumeric إذا كانت النتيجة 0 أو false فهي القيمة المطلوبة

مرفق شيت به 1000 اختصار لبرنامج الاكسيل لتسهيل العمل منظم حسب الاصدارات للاستاذ/ محمود سيد جزاه الله خيرا 1000 اختصار للاكسيل محمود سيد.xlsx

وعليكم السلام ورحمة الله وبركاته .. نعم أخي تستطيع ذلك ، في المرفق التالي فكرة مشتقة من أحد المشاريع القديمة ، وتقوم بنفس الطلب الذي تريده . فقط املأ الارقام وانقر زر ارسال واتس اب تم حذف بعض الوظائف الخاصة بالمشروع الأصلي .. WhatsApp Sender WF.accdb

لفصل الحروف والارقام داخل الاستعلام انت بحاجة الى دالة مثل هذه 'فصل الحروف Public Function textNum(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then Else lets3 = lets3 & lets End If Next textNum = lets3 End Function 'فصل الارقام Public Function Numtext(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then lets2 = lets2 & lets End If Next Numtext = lets2 End Function ولإنشاء جدول جديد يمكنك استخدام الاستعلام نفسه انظر المرفق فصل الحروف عن الارقام دالة2 .rar

وعليكم السلام ورحمة الله وبركاته استخدم هذا المعادله واسحبها الي قدر ما تحتاج من الصفوف =CLEAN(TRIM(C2))

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام المعادلة نم اسخبها للاسفل =TEXT(D7;"dd/mm/yyyy") تحويل التاريخ الى نص.xlsx

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أدعوكم لتجربة فكرة جديدة تم تنفيذها من خلال آكسيس ( هذا العملاق الصغير 😅 ) . بحيث أُجري تطويراً على فكرة تدعم المبرمجين والمطورين وتمكنهم من إنشاء نظام تفعيل عن بعد ( Online - سحابي ) ؛ بحيث لا يكون على المستخدم سوى إرسال رقم معرف جهازه فقط للمطور ، وما على المطور إلى تفعيل حسابه حسب المدة ( أنواع الإشتراكات ) التي يقدمها مطور البرنامج . وعليه فإنه في هذه المرحلة ، سأطلب ممن يرغب بالمشاركة ( فضلاً وكرماً منه لا أمراً ) أن يقوم بإرسال صورة لواجهة البرنامج الذي سأرفقه تالياً ، مع رقم معرف جهازه فقط . وسأقوم بدوري بتفعيل البرنامج المؤقت له بأشتراكات متنوعة لتجربة الفكرة . وكفكرة على المطلوب ، سأبدأ بنسخة من جهازي كتجربة لتتوضح لكم آلية المشاركة .. عند فتح القاعدة لأول مرة ، سيتم الإتصال بالسيرفر لتسجيل رقم جهازك ( أول مرة فقط ) . لذا شكراً لانتظارك وصبرك 😇 بعد الإتصال بالسيرفر ، سيتم اعتماد مدة تجريبية = 14 يوم وهذه الصورة المطلوبة منك عزيزي القارئ ثم من زر النسخ ، إنسخ رمز المعرف لجهازك ، وألصقه كاملاً كما في مثالي التالي 🤗 ID-0223222033111131825422051 التفعيل يعتمد على اتصال الجهاز بالإنترنت ، حالنا كحال الشركات التي تعتمد على سيرفر خاص بها بالتفعيل 😎 ، لذا لن تفيدك المحاولة بدون اتصال بالإنترنت . نسخة تعمل على النواة 64 :- Officena64.zip نسخة تعمل على النواة 32 :- Officena32.zip

إلى الإخوة الأعزاء، لاحظت في المنتدى أن الكثير يعاني من مشكلة حفظ الملفات في المرفقات باستخدام الماسح الضوئي، فأحببت أن أشارككم هذه الطريقة البسيطة لأبسط الحلول التي يمكننا القيام بها. ممكن تعدل عليها مثل ما بدك وبدون الحاجه الى تفعيل اي شيء في الاكسيس Microsoft Windows Image Acquisition Library v2.0 24.rar

قمت بالتعديل على ملفك وإن شاء الله يكون هو الحل المطلوب كل شيئ موضح في الملف المرفق تحياتي basetimes.rar

Converter 64.zip Converter 32.zip

جرب تنسيق الخلايا هذا: [$-2060000]0

اليك التعديل كلمة المرور 1234 اظافة زر تعديل وخذف للفورم.xlsm

للتجربة تفضل لعله المطلوب إن شاء الله OK lina_٠١٤٠٢٤.xlsx

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

تقضل للتجربة لعله المطلوب V1 مجزر .xlsx

المطلوب الأول هو من جنس المطلوب الثاني ولا داعي لتكرار الجداول المعادلات المستخدمة هي من نوع الصفيف وليست معادلات عادية تفضل example1.xlsx

الاخوه الأفاضل @Foksh @منتصر الانسي كل الشكر والتقدير لكم وبارك الله بكم وبعلمكم

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

في اكسس عند استخدام المعيار LIKE بعض الرموز لها معاني خاصة (ليست مجرد أحرف عادية) أحد هذه الرموز هو # معنى الرمز # في معيار LIKE (بدون أقواس) # لا يعني "حرف شباك" بل معناه: أي رقم من 0 إلى 9 (wildcard للأرقام) مثال: Like "12#4" سيجلب قيم مثل 1234 1254 1294 لكن لن يجلب النصوص التي فيها الحرف # فعليا الحل إذا أردنا البحث عن الرمز نفسه # نكتبه داخل أقواس مربعة [ ] حتي نقول لـ اكسس خذ هذا الرمز كحرف نصي عادي وليس كـ wildcard مثال: Like "*[#]*" هذا سيجلب أي نص يحتوي فعليا على الرمز # مثل 5365# abc#123 #start خلاصة القول الفصل # وحده = يعني "أي رقم" [ # ] = يعني الحرف # بالضبط كقيمة نصية

المثال: hashtags_01.accdb

حلول ذكية منقولة الحل الأول: Function Survivor(pCount As Integer) As Variant Dim Res As String Survivor = "#NUM!" If pCount < 1 Or pCount > 511 Then Exit Function Res = WorksheetFunction.Dec2Bin(pCount) Res = Mid(Res, 2) & Left(Res, 1) Survivor = WorksheetFunction.Bin2Dec(Res) End Function الحل الثاني: Function Survivor(pCount As Integer) As Integer Dim Prisoners As String Dim k As Integer, v As Integer Prisoners = String(pCount, "1") Do While Replace(Prisoners, "0", "") <> "1" k = InStr(v + 1, Prisoners, "1"): If k = 0 Then k = InStr(1, Prisoners, "1") v = InStr(k + 1, Prisoners, "1"): If v = 0 Then v = InStr(1, Prisoners, "1") Prisoners = Left(Prisoners, v - 1) & "0" & Mid(Prisoners, v + 1) Loop Survivor = InStr(1, Prisoners, "1") End Function آمل من المشرفين الكرام إقفال هذا الموضوع فقد وئد في يومه الأول. شكرا للجميع.

المحاضرة الثانية: Get and Post with JSON using Microsoft Access and VBA أولا التعريف: Get and Post with JSON using Microsoft Access and VBA هو أسلوب برمجي بيسمح لبرنامج Microsoft Access (عن طريق لغة VBA) إنه يتواصل مع خدمات ويب (Web APIs) باستخدام بروتوكول HTTP ويرسل أو يستقبل بيانات بصيغة JSON. GET Request: يعني جلب بيانات من API. مثلاً تسحب بيانات العملاء أو المنتجات من سيرفر خارجي وترجعلك على شكل JSON. POST Request: يعني إرسال بيانات إلى API. مثلاً تبعت فاتورة أو عملية جديدة للسيرفر بصيغة JSON. JSON (JavaScript Object Notation): صيغة خفيفة وبسيطة لتمثيل البيانات (key-value) تُستخدم على نطاق واسع لتبادل المعلومات بين التطبيقات. كيف يتم داخل Access؟ إرسال الطلب باستخدام مكتبات زي: MSXML2.XMLHTTP أو WinHttp.WinHttpRequest تحديد Headers المطلوبة زي Content-Type: application/json أو Authorization لو في مفتاح API. إرسال أو استقبال JSON: في GET → السيرفر بيرجع JSON. في POST → بتبعت JSON (زي بيانات مستخدم أو طلب) والسيرفر يرد باستجابة JSON. تحليل (Parse) JSON: باستخدام مكتبة خارجية زي VBA JSON عشان تقدر تحوله من نص إلى كائنات (Dictionaries / Collections) يسهل التعامل معاها في VBA. الفائدة العملية في Access ربط قاعدة بيانات Access بـ أنظمة خارجية (مثلاً ERP, CRM, مواقع تجارة إلكترونية). مزامنة البيانات بين Access و خدمات الإنترنت. إنشاء تكامل مع REST APIs (مثلاً Google Maps, WhatsApp APIs, خدمات شحن). ثانيا: ملخص الاجتماع الحوار كان عبارة عن عرض تقديمي تقني قدمه شخص يدعى "نيل سيرجنت" حول استخدام JSON (صيغة لتبادل البيانات) مع برنامج Microsoft Access. النقاط الأساسية في الحوار: المشكلة: لدى "نيل" عميل (شركة اختبارات كهربائية) يستخدم نظامًا قديمًا مبنيًا على Access لإدارة كل شيء تقريبًا (فواتير، عملاء، رواتب)، ما عدا جدولة مواعيد المهندسين في المواقع. الحل: تستخدم الشركة تطبيقًا خارجيًا (طرف ثالث) اسمه Field Motion لجدولة المواعيد عبر الويب وتطبيقات الجوال. التحدي التقني: كان التحدي هو ربط النظامين معًا؛ أي جعل نظام Access يرسل ويستقبل البيانات من تطبيق Field Motion. كيف تم الربط؟ 1. إرسال البيانات (Posting): o يقوم نظام Access بتجميع بيانات الوظائف الجديدة (مثل تفاصيل العميل والموقع والاختبارات المطلوبة) من جداوله. o يتم تحويل هذه البيانات إلى صيغة JSON. o يتم إرسال ملف الـ JSON هذا إلى الواجهة البرمجية (API) الخاصة بتطبيق Field Motion، الذي يقوم بدوره بإنشاء المواعيد في نظامه. 2. استقبال البيانات (Getting): o بعد أن يقوم المهندسون بتنفيذ عملهم وتسجيل البيانات في تطبيق Field Motion (مثل الوقت المستغرق، نتائج الاختبارات)، يقوم نظام Access بطلب هذه البيانات. o يرسل Field Motion البيانات مرة أخرى بصيغة JSON. o يقوم نظام Access بقراءة ملف الـ JSON وتخزين البيانات في جداوله لتحديث سجلات العملاء، حساب الرواتب، وإصدار الفواتير. باختصار، الحوار كان شرحًا عمليًا لكيفية جعل برنامج Access يتواصل مع خدمة ويب حديثة عن طريق تحويل البيانات من وإلى تنسيق JSON، مع التركيز على عملية "إرسال" البيانات، وهي الأقل شيوعًا وشرحًا على الإنترنت مقارنة بعملية "استقبال" البيانات. و لمزيد من التوضيح . دعنا نتعمق في التفاصيل ونشرح الأمر بطريقة أبسط، وكأننا نبني جسرًا بين نظامين مختلفين. تخيل أن لديك مكتبين: 1. المكتب الرئيسي (يمثله Microsoft Access): هذا هو نظامك القديم والمخضرم. فيه كل سجلات الشركة الأساسية، بيانات العملاء، الحسابات، وكل القرارات الإدارية الهامة. إنه قوي وموثوق به، لكنه غير مرن ولا يعمل بشكل جيد على الإنترنت أو الهواتف المحمولة. 2. المكتب الميداني (يمثله تطبيق Field Motion): هذا هو النظام الحديث والمرن. يعمل على الويب والهواتف، وهو مثالي للمهندسين الذين يتنقلون. يسمح لهم بمعرفة مواعيدهم، تسجيل بيانات عملهم بسهولة من أي مكان. المشكلة هي أن هذين "المكتبين" لا يتحدثان نفس اللغة ولا يتواصلان مع بعضهما البعض. وهنا يأتي دور التقنيات التي شرحها "نيل". شرح المفاهيم الأساسية بتبسيط 1. لغة التواصل المشتركة (JSON) لكي يفهم النظامان بعضهما، يحتاجان إلى لغة مشتركة. هذه اللغة هي JSON. فكر في JSON كأنه نموذج بسيط وموحد لكتابة المعلومات. بدلاً من إرسال جدول معقد من Access، يقوم النظام بترجمة البيانات إلى نص بسيط ومفهوم لأي كمبيوتر. مثال: بدلاً من إرسال سجل معقد من قاعدة البيانات، يتم إرسال نص كهذا: JSON { "customerName": "شركة الأمل", "address": "123 شارع النصر, القاهرة", "task": "فحص إنذار الحريق", "engineerID": "E105" } هذا التنسيق البسيط والمقروء هو لغة JSON. 2. ساعي البريد (API - الواجهة البرمجية) الآن بعد أن أصبح لدينا لغة مشتركة، نحتاج إلى "ساعي بريد" لنقل الرسائل (البيانات) بين النظامين. هذا الساعي هو API. الـ API هو الوسيط الذي يسمح للبرامج المختلفة بالتحدث مع بعضها البعض. نظام Access يعطي الرسالة (بيانات JSON) إلى الـ API، والـ API يتكفل بتوصيلها بشكل آمن وصحيح إلى نظام Field Motion، والعكس صحيح. شرح سير العمل خطوة بخطوة دعنا نتبع رحلة معلومة واحدة من البداية إلى النهاية: المرحلة الأولى: إرسال أمر عمل جديد (POSTING) 1. إنشاء الوظيفة: يقوم موظف في المكتب الرئيسي بإنشاء وظيفة جديدة في نظام Access (مثلاً: العميل "شركة الأمل" يحتاج إلى فحص أجهزة). 2. الترجمة إلى JSON: يقوم نظام Access بأخذ تفاصيل هذه الوظيفة ويحولها إلى "رسالة" مكتوبة بلغة JSON. 3. إرسال الرسالة: يسلّم Access هذه الرسالة إلى "ساعي البريد" (API). هذه العملية تسمى POST، لأننا "نَنشر" أو "نُرسل" معلومات جديدة ليتم تخزينها في النظام الآخر. 4. استلام وفهم الرسالة: يستلم نظام Field Motion الرسالة عبر الـ API، يقرأها، ويفهم أنه يجب إنشاء موعد جديد. 5. النتيجة: يظهر الموعد الجديد تلقائيًا في جدول المهندس على تطبيق Field Motion في هاتفه. المرحلة الثانية: استلام تقرير العمل المنجز (GETTING) 1. إنجاز العمل: يذهب المهندس إلى موقع العميل، يقوم بالفحص، ثم يفتح تطبيق Field Motion ويسجل ملاحظاته (مثلاً: "تم العمل في ساعتين، كل شيء سليم"). 2. طلب التحديثات: بشكل دوري (مثلاً كل ساعة)، يسأل نظام Access "ساعي البريد" (API) سؤالاً: "هل هناك أي تقارير جديدة من المهندسين؟". هذه العملية تسمى GET، لأننا "نحصل" أو "نجلب" معلومات موجودة بالفعل. 3. إحضار الرد: يذهب الـ API إلى نظام Field Motion، يجد تقرير المهندس الجديد، يترجمه إلى لغة JSON، ويعود به إلى Access. 4. تحديث السجلات: يستلم Access التقرير، ويفهم أن المهمة قد اكتملت. يقوم تلقائيًا بتحديث حالة الوظيفة، ويجهز الفاتورة لإرسالها للعميل، ويضيف ساعات العمل إلى راتب المهندس. لماذا كل هذا مهم؟ هذا الربط التقني يحل مشاكل حقيقية: الأتمتة: بدلاً من أن يقوم موظف بإعادة إدخال البيانات يدويًا من نظام إلى آخر، كل شيء يحدث تلقائيًا. تقليل الأخطاء: الأتمتة تمنع الأخطاء البشرية الناتجة عن النسخ واللصق أو إعادة الكتابة. الكفاءة والسرعة: يتم تحديث المعلومات بشكل فوري بين المكتب الرئيسي والميدان، مما يجعل العمل أسرع وأكثر سلاسة. تحديث الأنظمة القديمة: يسمح لنظام قديم وقوي مثل Access بالاستفادة من مزايا التقنيات الحديثة (الويب والجوال) دون الحاجة إلى التخلي عنه وإعادة بناء كل شيء من الصفر. ثالثا: نص الحوار باللغة الإنجليزية مرفق مع هذه المشاركة ان شاء الله AL; Get and Post with JSON using Microsoft Access and VBA by Neil Sargent (+ theDBguy) (English_ASR).rar

من الواضح أن الأخ @figo82eg يبحث عن الجماليات ليظهر علامتي الصح والخطأ بشكل والوان مميزة ولكني أضم صوتي لصوت الأخ @AbuuAhmed في أن إستخدام حقل نعم/لا هو السبيل الأفضل والأسهل ولكن بمراجغة الحل الذي طبقه فيه مشكلة لأن مربع التحديد غير مرتبط بحقل في الجدول لذلك إذا قمت مثلا بتحديد السجل الأول وإنتقلت للسجل الثاني سيظل التحديد True رغم أن قيمة الحقل المفترض أنها False لذا مسكت العصا من المنتصف وقمت بتعديل المثال ليحقق الأمرين تحياتي BlockExam_03.rar

أيضاً كإضافة عن الإستعلام السابق .. جرب هذا الإستعلام أيضاً لإنشاء جدول جديد ، واضافة القيم فيه بعد فصلها .. SELECT maal, IIF(IsNumeric(Left(Trim(maal), 1)) = True, Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)), Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)) ) AS الرقم, IIF(IsNumeric(Left(Trim(maal), 1)) = True, Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)), Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)) ) AS الاسم INTO TAGE_F FROM TAGE WHERE maal Is Not Null;

وهاتان دالتان كتبتهم من زمان 🙂🌷 : *دالة تفصل الأرقام عن الحروف ودالة تفصل الحروف عن الأرقام* *شرح الكود:* الدالة تستخرج الأرقام من جمله تحتوي على أرقام وحروف .. مثال1 : " أسماء الله 99 أسما " - النتيجة: 99 مثال2 : " أسماء الله 99 أسما " - النتيجة: أسماء الله أسما *الكود:* '==========================================(لاستخراج الأرقام فقط من النص) Public Function ExtractNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If IsNumeric(L) Then r = r & L End If Next x ExtractNumbersFromText = Trim(r) End Function '==========================================(ولإزالة الأرقام من النص والإبقاء على الحروف فقط) Public Function RemoveNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If Not IsNumeric(L) Then r = r & L End If Next x RemoveNumbersFromText = Trim(r) End Function *طريقة الاستدعاء (الاستخدام):* ExtractNumbersFromText("Your text with 123456 Here") RemoveNumbersFromText("Your text with 123456 Here") *مكتبة الأكواد*

الحمد لله توصلت لبعض الاكواد الرائعة ولتعميم الافادة إليكم الملف وبه 7 اكواد للنسخ وللنقل ومع الحفاظ على التنسيق وبدونه وايضا اضافة شرط رابع مع الحفاظ على ما تم نقله Book1 (1).rar

تفضل الملف و جرب كتابة اسماء بها عبد في العمود الثالث و طبق عليها ما تريد حذف المسافات(1).xlsm