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

السلام عليكم كود طباعة وكود تحويل 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

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

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

لو عندك اكسيل حديث 365 مثلا يمكن استعمال الصيغة التالية =TEXTJOIN("",TRUE,القرار!AM24:AM39,القرار!AN24:AN39) و يمكن بالأكواد مع الاصدارات القديمة و ده يلزم وجود ملف عشان نتأكد من النتيجة

Converter 64.zip Converter 32.zip

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

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

تفضل أخي و يمكن اختيار الرقم من قائمة منسدلة تبادل معلوات ورقتين(1).xlsx

المشكلة تظهر لشهري 8 و 9 وليس 9 فقط والسبب هي وجود قيم فارغة في الحقل Add_Days التابع للجدول moa_details الان لديك حلين إما تعبئة الحقول الفارغة بالقيمة 0 أو إستخدام دالة Nz في الإستعلام تحياتي

جربت الملف لا توجد اي مشكلة الكود يعمل جيدا , اذا كان pdf مفتوحا تخدت هذه المشكلة او اذا كان اسم العميل يحتوى على اي من الحروف الاتية تخدث المشكلة \ / : * ? " < > | جرب على جهاز احر وتامل من الاعضاء التجربة لنتاكد

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

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

بعد إذن الأخ @Foksh قمت بتعديل المثالين لدمج القيم بدون تكرار قد يكون هذا التعديل غير ملائم لصاحب السؤال ولكني رأيت وضعه لإثراء الموضوع (وقد يحتاجه أحد الأعضاء مستقبلاً) تحياتي at_aziz.rar

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

المثال: hashtags_01.accdb

وعليكم السلام ورحمه الله وبركاته راجع الملف لعله المطلوب

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

أيضاً كإضافة عن الإستعلام السابق .. جرب هذا الإستعلام أيضاً لإنشاء جدول جديد ، واضافة القيم فيه بعد فصلها .. 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).xlsm

السلام عليكم برنامج مبيعات ./. برنامج حركات مالية كيف يتم هذا ؟ يجب علينا تصور وتخيل العملية اين محل الصناديق والبنك في جدول البيع والشراء ؟ هل يتم رصد اسم الصندوق في جدول المبيعات عند حركة البيع؟ حتى يفهم منه ان المال دخل الى الصندوق الفلاني ام انه يتم ايداع أو صرف وتحويل المبالغ بعمليات وجداول مستقلة ؟ اذا صحيح .. فجداول المبيعات لا محل لها من الاعراب هنا عرض جميل ومثال اجمل لدي ملاحظة بل اثنتان 1- ما اقتبسته اعلاه ليس له محل في جداول العمليات المالية .. الا ان قصدت بالخصم ما يتم داخل الاستعلامات 2- رأيي ان نضم البنوك الى الصناديق في جدول واحد .. وفي جدول الحركة يكفي حقلان (من / الى) واللذان يمثلان المعرف

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