اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  1. ابوخليل

    ابوخليل

    أوفيسنا


    • نقاط

      34

    • Posts

      13591


  2. عبدالله بشير عبدالله
  3. Foksh

    Foksh

    أوفيسنا


    • نقاط

      25

    • Posts

      4399


  4. hegazee

    hegazee

    03 عضو مميز


    • نقاط

      16

    • Posts

      245


Popular Content

Showing content with the highest reputation since 12/14/25 in all areas

  1. اعرض الملف إجعل مربع القائمة يتناسق مع بقية تنسيقات النموذج بإستخدام أداة مربع القائمة المخصص {سلسلة الأدوات المساعدة المخصصة} كما يعلم الجميع فإن عنصر التحكم (مربع القائمة) القياسي من عناصر التحكم التي لاتمنحنا خيارات أوسع في التنسيق كمحاذاة النص أو تغيير لون الخط أو لون التحديد وغيرها من التنسيقات التي تجعله يتماشى مع بقية عناصر التحكم بإستخدام هذه الأداة سنحصل على مربع قائمة مخصص يقوم بمنحنا خيارات تنسيق واسعة مرفق لكم مجلد يحتوي على - نسخة توضيحية لوظائف الأداة (أرجو أن يتم فتح هذا الملف في البداية) - مستند وورد يحتوي على تعليمات (يرجى قرائتها بتركيز وتطبيق الخطوات كما وردت) يحتوي هذا المستند في نهايته على تلميحات مهمة ستساعدكم في حال ظهور بعض الأخطاء أثناء العمل - نسخة بإسم القالب والتي وكما تعودنا بأنها ستحتوي على الكائنات الضرورية لعمل الأداة - ملف مضغوط يحتوي على نسخة تدريبية ليتم تطبيق الخطوات الواردة في التعليمات عليها الملاحظة التي أود تقديمها هنا أنه في البداية قد يواجه البعض صعوبة في العمل مع الإداة والذي يمكن تجاوزها بقراءة وتنفيذ التعليمات أكثر من مرة لذلك تم وضع النسخة التدريبية في ملف مضغوط حتى يمكنكم الحصول على نسخة فارغة جديدة في حال أردتم إعادة تطبيق التعليمات للتدرب تحياتي صاحب الملف منتصر الانسي تمت الاضافه 01/09/26 الاقسام قسم الأكسيس  
    3 points
  2. Version 1.0.0

    21 تنزيل

    كما يعلم الجميع فإن عنصر التحكم (مربع القائمة) القياسي من عناصر التحكم التي لاتمنحنا خيارات أوسع في التنسيق كمحاذاة النص أو تغيير لون الخط أو لون التحديد وغيرها من التنسيقات التي تجعله يتماشى مع بقية عناصر التحكم بإستخدام هذه الأداة سنحصل على مربع قائمة مخصص يقوم بمنحنا خيارات تنسيق واسعة مرفق لكم مجلد يحتوي على - نسخة توضيحية لوظائف الأداة (أرجو أن يتم فتح هذا الملف في البداية) - مستند وورد يحتوي على تعليمات (يرجى قرائتها بتركيز وتطبيق الخطوات كما وردت) يحتوي هذا المستند في نهايته على تلميحات مهمة ستساعدكم في حال ظهور بعض الأخطاء أثناء العمل - نسخة بإسم القالب والتي وكما تعودنا بأنها ستحتوي على الكائنات الضرورية لعمل الأداة - ملف مضغوط يحتوي على نسخة تدريبية ليتم تطبيق الخطوات الواردة في التعليمات عليها الملاحظة التي أود تقديمها هنا أنه في البداية قد يواجه البعض صعوبة في العمل مع الإداة والذي يمكن تجاوزها بقراءة وتنفيذ التعليمات أكثر من مرة لذلك تم وضع النسخة التدريبية في ملف مضغوط حتى يمكنكم الحصول على نسخة فارغة جديدة في حال أردتم إعادة تطبيق التعليمات للتدرب تحياتي
    3 points
  3. وعليكم السلام ورحمة الله وبركاته جرب الكود في الملف المرفق 1الجرد.xlsm
    3 points
  4. لدي هذا التطبيق يقوم باختبارات ادارية متنوعة ارجو ان تبدو رأيكم فيه مع جزيل الشكر Administrative_Tests.rar
    3 points
  5. ممكن يكون طلبك هنا https://www.youtube.com/watch?v=M1DhpzkT8kA او جرب هذا الكود: Sub Observer_FullSystem() Dim ws As Worksheet, wsReport As Worksheet Dim NamesArr() As Variant Dim UsedRow As Object, UsedCol As Object, UsedAll As Object Dim lrNames As Long, lrRows As Long, lrCols As Long Dim r As Long, c As Long, i As Long Dim Available() As String Dim cnt As Long, MaxAllowed As Long, TotalCells As Long Dim TryCount As Long Dim MainCols As Long: MainCols = 2 ' عدد الأعمدة الأساسية Set ws = ActiveSheet Application.ScreenUpdating = False Randomize ' ===== Backup ===== ws.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = "Backup_" & Format(Now, "ddmmyy_hhmmss") ws.Activate ' ===== قراءة الأسماء ===== lrNames = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row NamesArr = ws.Range("B3:B" & lrNames).Value ' ===== حدود الجدول ===== lrRows = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row lrCols = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column ws.Range(ws.Cells(3, 4), ws.Cells(lrRows, lrCols)).ClearContents ' ===== الحد الأقصى ===== TotalCells = (lrRows - 2) * (lrCols - 3) MaxAllowed = Application.WorksheetFunction.RoundUp(TotalCells / (lrNames - 2), 0) Set UsedAll = CreateObject("Scripting.Dictionary") ' ===== التوزيع ===== For r = 3 To lrRows Set UsedRow = CreateObject("Scripting.Dictionary") For c = 4 To lrCols TryCount = 0 RetryCell: TryCount = TryCount + 1 If TryCount > 300 Then GoTo NextCell Set UsedCol = CreateObject("Scripting.Dictionary") For i = 3 To r - 1 If ws.Cells(i, c).Value <> "" Then UsedCol(ws.Cells(i, c).Value) = 1 Next i cnt = 0 ReDim Available(1 To UBound(NamesArr, 1)) For i = 1 To UBound(NamesArr, 1) If Not UsedRow.exists(NamesArr(i, 1)) _ And Not UsedCol.exists(NamesArr(i, 1)) Then If Not UsedAll.exists(NamesArr(i, 1)) _ Or UsedAll(NamesArr(i, 1)) < MaxAllowed Then cnt = cnt + 1 Available(cnt) = NamesArr(i, 1) End If End If Next i If cnt > 0 Then ws.Cells(r, c).Value = Available(Int(Rnd * cnt) + 1) UsedRow(ws.Cells(r, c).Value) = 1 UsedAll(ws.Cells(r, c).Value) = UsedAll(ws.Cells(r, c).Value) + 1 Else GoTo RetryCell End If NextCell: Next c Next r ' ===== تقرير ===== On Error Resume Next Set wsReport = Sheets("تقرير") On Error GoTo 0 If wsReport Is Nothing Then Set wsReport = Sheets.Add wsReport.Name = "تقرير" Else wsReport.Cells.Clear End If wsReport.Range("A1:D1") = Array("الاسم", "الإجمالي", "أساسي", "احتياطي") For i = 3 To lrNames wsReport.Cells(i - 2, 1) = ws.Cells(i, 2) wsReport.Cells(i - 2, 2) = Application.CountIf(ws.Range(ws.Cells(3, 4), ws.Cells(lrRows, lrCols)), ws.Cells(i, 2)) wsReport.Cells(i - 2, 3) = Application.CountIf(ws.Range(ws.Cells(3, 4), ws.Cells(lrRows, 3 + MainCols)), ws.Cells(i, 2)) wsReport.Cells(i - 2, 4) = wsReport.Cells(i - 2, 2) - wsReport.Cells(i - 2, 3) Next i wsReport.Columns.AutoFit Application.ScreenUpdating = True MsgBox "تم التوزيع + إنشاء نسخة احتياطية + تقرير كامل ?", vbInformation End Sub
    3 points
  6. اعلم هذا وواضح بالملف وعملت في قطاع التعليم التقني والتوجيه الفني 39 سنة واعلم جيدا كيف عمل اللجان لم يكن الامر يتطلب كل هذا على كل حال عودة للملف اليك الملف بالتعديل الاخير مراقبة_ تحويل اللجان الى أسماء.xlsm
    3 points
  7. دائما لك نكهة خاصة مميزة 😋👌🌹 إبداع وإمتاع
    3 points
  8. وعليكم السلام ورحمة الله وبركاته جرب هذا تسلسل ملئ بيانات الفورم1.xlsm
    3 points
  9. وعليكم السلام ورحمة الله وبركاته خمل المرفق به مثال لتحويل نطاق نطاق معين محدد بالماوس الى pdf pdf1.xlsb
    3 points
  10. و عليكم السلام ورحمة الله وبركاته __اصناف مشتريات - نسخة2.xlsx
    2 points
  11. المصدر هو الاستعلام والتعديل في الاستعلام .. بدل اخذ Nr من جدول TblDetaché تم اخذه من جدول tbl_Loans
    2 points
  12. توزيع رقم على خلايا.xlsm
    2 points
  13. و عليكم السلام ورحمة الله و بركاته الموضوع سهل جدا من خلال عمل فلترة الموجودة في اكسيل كما هو واضح بالصور. ممكن تستخدم أيا من الملفين واحد بالأكواد و الثاني بالصيغ بس لا يصلح إلا أوفيس 365 أو 2021 فلترة.7z
    2 points
  14. تفضل الملف باستخدام الصيغ مع عمل تنسيق شرطي للتأكد من التكرار كشاف دخول اللجان2.xlsm
    2 points
  15. وعليكم السلام ورحمة الله وبركاته InputBox في VBA لا يدعم إخفاء النصوص أو إظهارها كنجوم بشكل مباشر. الحل هو استخدام UserForm مع TextBox خاصية PasswordChar طباعة.xlsm
    2 points
  16. الاسهم في ملفك لم تشمل الاحتياطي اليك الملف تكملة1 مراقبة 2026.xlsm
    2 points
  17. اذا كنت تقصد عمل كلمة مرور للزر في الفورم يمنع الدخول الى ملف الاكسل اليك طلبك كلمة المرور 1234 يمكنك تعديلها من الكود طباعة2.xlsm
    2 points
  18. وعليكم السلام ورحمة الله وبركاته ،، جرب هذا التعديل الذي تم على الجمل الشرطية داخل الاستعلام عند التوزيع .. لجان الامتحانات.zip
    2 points
  19. تفضل استاذ @figo82eg طلبك حسب ما فهمت . ووافني بالرد . الرقم القومى-1.rar
    2 points
  20. 2 points
  21. السلام عليكم ورحمة الله وبركاته اقدم لكم شرح مبسط لطريقة بحث احترافيه في شيت اكسل رابط الفيديو لتحميل ملف العمل https://www.mediafire.com/file/4t7skm26bdj2mhk/salloum.xlsx/file
    2 points
  22. تجسيداً لفكرة التعامل مع التقرير .. هذه الفكرة المبدأية لشكل التقرير عند فتحه بعد حفظ التصميم ، وتصديره الى ملف PDF .. مسارات ومواضع العناصر في الفيديو تم تجربتها مسبقاً . لذلك هي معروفة لي .
    2 points
  23. اهلا اخي العزيز صاحب الموضوع مشغول .. ولا اخفيك الفكرة راقت لي .. وعملت اضافات .. منها دالة لاختيار رقم عشوائي لذا دعنا نعمل عليه انت وأنا كبرنامج اختبار وقياس قابل لأكثر من رغبة سوف افتح موضوعا جديدا واطرح آخر تعديل ثم انتظر اضافاتك ولمساتك وهكذا حتى يخرج بثوب مناسب ما رأيك ؟
    2 points
  24. بارك الله فيك .. وللمرة المليون أسف على تعب حضرتك وجعله في ميزان حضرتك ... وهذا أملنا في هذا المنتدى العظيم بأساتذته
    2 points
  25. اليك ما طلبت بالتنسيق الشرطي aaaa2.xlsm
    2 points
  26. شكراً لك معلمي الفاضل 🤗.. إن شاء الله جاري العمل على التنفيذ بحيث يتم الإخراج من خلال تقرير، ولكن بعد الإنتهاء من بعض التعديلات بحيث سيتم اسناد جدول او استعلام كمصدر سجلات للتقرير ، مع ضم مربعات النص الي حقول بدلاً من الإدخال اليدوي للبيانات المتغيرة مثل الاسم او الدرحة ..... الخ . مع إتاحة التصدير كملف PDF طبعاً . وغيرها من الإضافات 😇 .
    2 points
  27. السلام عليكم تحية صباحية طيبة وبعد، عزيزي الفاضل، اعلم أن هدفك هو تحويل الأرقام إلى أسماء، وهو موجود من عنوان مشاركتك وردودك المتتابعة. لكنني أواجه صعوبة في المضي قدماً؛ لأنك لم تحدد المعايير الدقيقة لعملية التحويل، ولم تتفضل بالإجابة عن الأسئلة التي طرحتها عليك في الردود السابقة. أقر بعجزي عن استيعاب فكرة التحويل بوضوح، وربما تكون سنواتي الـ 63 قد جعلتني أجد صعوبة في استيعاب هذا الأمر. لذلك، أعتذر عن عدم قدرتي على إفادتك في هذا الطلب. أتمنى من الأخوة الأعضاء والخبراء الذين استوعبوا آلية العمل أن يقدموا المساعدة اللازمة لك. مع خالص التقدير.
    2 points
  28. رائع جدا هذه صورة لعملية الاعداد الجميل والشكل النهائي اتمنى اخي ان يتاح الاخراج عبر تقرير .. لما له من المزايا العديدة المفيدة
    2 points
  29. وعليكم السلام ورحمة الله وبركاته .. جرب في زر فتح التقرير الحدث التالي :- DoCmd.OpenReport "تقرير تصفية", acViewPreview, , _ "[اسم_المستفيد] Like '*" & Forms!Index!s & "*' " & _ "OR [رقم/اسم المبنى] Like '*" & Forms!Index!s & "*' " & _ "OR [الادارة] Like '*" & Forms!Index!s & "*'" 100.zip
    2 points
  30. السلام عليكم لم توضخ خلية البحث G1 لها علاقة بالتوزيع ام لا فيكون التوزيع فردي ام للكل على كل حال الملف فيه عدد 2 شيت الاول شيت DATA يقوم بالتوزيع الفردي للمراقب وذلك بالاختيار من الخلية G1 الثاني شيت DATA1 به كود يقوم بتوزيع اللجان على كل المراقبين جرب الملف المرفق متمنيا ان يكون فيه طلبك ملاحظة1_2026.xlsm
    2 points
  31. السلام عليكم ورحمة الله وبركاته الان وضحت الفكرة بارك الله فيك تم عمل كمبوبوكس به اسماء الموظفين الازار المرقمة قي القورم اكوادها موحودة كما هي اعتقد بعد الكمبوبوكس لم تعد في حاجة اليها ان اردت الغائها فابلعنى جرب الملف وان كنت تحتاج الى تعديل في الفورم فابشر تحياتى لك حضور وخروج موظفين.xlsm 4495.xlsm
    2 points
  32. السلام عليكم نصيحه لك وبما انك عضو مميز اهتم بتسميات الجداول والحقول باللغه الانجليزيه حتى تسهل عليك العمل وكتابه الاكواد تفضل بطريقه بسيط عملت لك نموذج المشتريات وتركت لك الاخر لتعمله كى تتعلم بالتوفيقمخزن_1.accdb
    2 points
  33. تقبل الله منكم استاذ فوكش وعمرة مقبولة وعقبال حجة ن شاء الله
    1 point
  34. تفضل استاذ @figo82eg طلبك بالاستعلام Query1 .ووافني بالرد . New Microsoft Access Database-111.rar
    1 point
  35. وعليكم السلام ورحمة الله وبركاته عمي جعفر 🙂 سعدت بمرورك 😊🌹 تمام إن شاء الله .. بإذن الله أصلحه ما أمكن .. وآتيك بالخبر اليقين .. 👍
    1 point
  36. جرب المرفق التالي ( طبعا عند تحويل الموظف الى مطوي القيد يختفي من مجموعة الموظفين على رأس العمل ويجده في المطوي قيدهم تحويل.accdb
    1 point
  37. السلام عليكم حقيقة الدحول الى الموقع اصبح بالصدفة قليل ما تجدة يعمل الكود سليم والمشكلة في تنسيق الأرقام قي صفخة table في العمودين b& e اذا اردتها بالأرقام العربية حسب ملفك فقم بتنسيقها الى [$-,201]# وان اردتها بالأرقام الغربية اجعل النتسيق رفم بدون خانات عشرية ملف بتنسيق الارقام العربية [$-,201]# مراقبة ثانوية 2026.xlsm ملف بتنسيق الارقام الغربية مراقبة ثانوية1 2026.xlsm
    1 point
  38. ما رأيك بهذه الفكرة :- الملف مفتوح المصدر .. LblChanger - 1.zip
    1 point
  39. نعم الموقع من الامس انا لم انتظر خاصة وان المنتدى توقف .. عملت الذي ارى اني بحاجته .. والحقيقة حاجتي في بعض الازرار في نموذج واحد والسبب ان التغيير كله ينحصر فيها .. او لنقل الحاجة لو تم تغيير مسميات المواد الأصل اعتقد انها بنفس فكرتك ولكنها مختصرة جدا .. انظر الصورة الاولى وانظر الزر يظهر كأنه تسمية الى جانب كشوف المتابعة اسمه : تغيير التسميات ثم انظر للصورة الثانية بعد النقر عليه طبعا كل ما على المستخدم هو تغيير المسمى لما يريد ثم اعادة فتح النموذج
    1 point
  40. تريده هكذا أستاذ يوسف ؟ 🙂 JO_Lab.rar
    1 point
  41. شكرا جزيلا وربنا يبارك في حضرتك ويزيدك من علمه
    1 point
  42. نسيت متابعتي معك ، واعتذر لكن هل جربت استبدال Date باسم مربع النص الذي يحتوي التاريخ الذي تريد إضافة يوم عليه ؟؟؟
    1 point
  43. 1 point
  44. السلام عليكم ورحمة الله وبركاته اليوم اقدم لك وظيفة مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ غاية فى الروعة ومكتوبة بعناية واحترافية للحصول على اكبر قدر ممكن من الدقة فى الاداء والمرونة فى التناول عند الاستدعاء حيث أن الكود يعالج النصوص العربية بطريقة مرنة مع التركيز على ازالة المسافات وتنظيف النص و إزالة التشكيل و توحيد الاحرف ومعالجتها يعتمد الكود خيارين للعمل (إزالة المسافات أو التطبيع "توحيد الاشكال المختلفة للاحرف" ) مما يجعله قابلاً للتخصيص بناءً على الحاجة على سبيل المثال النص الاصلى والذى نريد معالجته : "تَجْرِبَةُ إِشْرَافٍ عَلَى? بَعْضِ الْأَمَاكِنِ أَوْ الْمَكَانِ رَقْمٌ 101" الحالات التى يمكن الحصول عليها من معالجة النص السابق هى ازالة المسافات فقط وتنظيف النص مع الابقاء على الارقام بدون التطبيع : تجربة إشراف على بعض الأماكن أو المكان رقم 101 ازالة المسافات وتنظيف النص مع الابقاء على الارقام مع التطبيع : تجربه اشراف علي بعض الاماكن او المكان رقم 101 ازالة المسافات وتنظيف النص مع ازالة الارقام مع التطبيع : تجربه اشراف علي بعض الاماكن او المكان رقم ازالة المسافات فقط وتنظيف النص مع ازالة الارقام بدون التطبيع : تجربة إشراف على بعض الأماكن أو المكان رقم الكود ' Function: ArabicTextSanitizer ' Purpose: Sanitizes Arabic text by removing non-Arabic characters, optionally normalizing the text, ' removing diacritics (harakat), and optionally removing numeric characters or spaces. ' Parameters: ' inputText (String): The Arabic text to be sanitized. It can contain Arabic characters, non-Arabic characters, ' diacritics, and numeric values. ' normalize (Boolean): Optional. If True, the text will be normalized by replacing specific Arabic characters ' with their standardized equivalents (default is True). ' RemoveNumbers (Boolean): Optional. If True, numeric characters (0-9) will be removed from the text (default is True). ' removeSpaces (Boolean): Optional. If True, all spaces in the text will be removed (default is False). ' Returns: ' String: The sanitized Arabic text with optional normalization, removal of numbers, and spaces. ' ' Example Use Cases: ' 1. Remove spaces only and clean the text while keeping numbers without normalization: ' ' Removes spaces from the text while keeping numbers and without normalizing the text. ' ' Example: ArabicTextSanitizer(inputArabicText, False, False, True) ' ' 2. Remove spaces and clean the text while keeping numbers and normalizing: ' ' Normalizes the text and removes spaces, while keeping numbers. ' ' Example: ArabicTextSanitizer(inputArabicText, True, False, True) ' ' 3. Remove spaces and clean the text while removing numbers and normalizing: ' ' Normalizes the text, removes spaces, and removes numbers. ' ' Example: ArabicTextSanitizer(inputArabicText, True, True, True) ' ' 4. Remove spaces only and clean the text while removing numbers without normalization: ' ' Removes spaces and numbers, but does not normalize the text. ' ' Example: ArabicTextSanitizer(inputArabicText, False, True, True) ' Public Function ArabicTextSanitizer(inputText As String, Optional normalize As Boolean = True, Optional RemoveNumbers As Boolean = True) As String On Error GoTo ErrorHandler ' Ensure the input is valid (non-empty and not null) If Nz(inputText, "") = "" Then ArabicTextSanitizer = "" Exit Function End If ' Initialize the sanitizedText with the trimmed input Dim sanitizedText As String sanitizedText = Trim(inputText) ' Step 1: Normalize the text if requested If normalize Then ' Define character replacement pairs for normalization Dim charReplacementPairs As Variant charReplacementPairs = Array( _ Array(ChrW(1573), ChrW(1575)), _ Array(ChrW(1571), ChrW(1575)), _ Array(ChrW(1570), ChrW(1575)), _ Array(ChrW(1572), ChrW(1608)), _ Array(ChrW(1574), ChrW(1609)), _ Array(ChrW(1609), ChrW(1610)), _ Array(ChrW(1577), ChrW(1607)), _ Array(ChrW(1705), ChrW(1603)), _ Array(ChrW(1670), ChrW(1580))) ' Apply replacements for character normalization Dim pair As Variant For Each pair In charReplacementPairs sanitizedText = Replace(sanitizedText, pair(0), pair(1)) Next ' Step 2: Remove diacritics (harakat) from the text Dim diacritics As String diacritics = ChrW(1600) & ChrW(1611) & ChrW(1612) & ChrW(1613) & ChrW(1614) & ChrW(1615) & ChrW(1616) & ChrW(1617) & ChrW(1618) Dim i As Integer For i = 1 To Len(diacritics) sanitizedText = Replace(sanitizedText, Mid(diacritics, i, 1), "") Next End If ' Step 3: Retain only Arabic characters, spaces, and optionally numbers Dim tempChars() As String Dim charIndex As Long Dim intChar As Integer Dim finalResultText As String ' Iterate through each character in the sanitized text For i = 1 To Len(sanitizedText) intChar = AscW(Mid(sanitizedText, i, 1)) ' Check for Arabic characters (range for Arabic characters and spaces) If intChar = 32 Or _ (intChar >= 1569 And intChar <= 1594) Or _ (intChar >= 1601 And intChar <= 1610) Or _ (intChar >= 1648 And intChar <= 1649) Then ReDim Preserve tempChars(charIndex) tempChars(charIndex) = ChrW(intChar) charIndex = charIndex + 1 ' Optionally, check for numbers if RemoveNumbers is False ElseIf Not RemoveNumbers And (intChar >= 48 And intChar <= 57) Then ReDim Preserve tempChars(charIndex) tempChars(charIndex) = ChrW(intChar) charIndex = charIndex + 1 End If Next ' Step 4: Join the valid characters into a final result text finalResultText = Join(tempChars, "") ' Step 5: Remove extra spaces (multiple consecutive spaces replaced with a single space) finalResultText = Replace(finalResultText, " ", " ") ' Improved space replacement Do While InStr(finalResultText, " ") > 0 finalResultText = Replace(finalResultText, " ", " ") Loop ' Step 6: Remove special characters (if needed) finalResultText = Replace(finalResultText, "*", "") finalResultText = Replace(finalResultText, "#", "") finalResultText = Replace(finalResultText, "@", "") finalResultText = Replace(finalResultText, ",", "") ' Return the sanitized text If Len(Trim(Nz(finalResultText, ""))) = 0 Then ArabicTextSanitizer = vbNullString Else ArabicTextSanitizer = finalResultText End If Exit Function ErrorHandler: Debug.Print "Error in ArabicTextSanitizer: " & Err.Description ArabicTextSanitizer = "" End Function وهذه الوظيفة تبين اشكال وطرق الاستدعاء المختلفة ' Subroutine: TestArabicTextSanitizer ' Purpose: Demonstrates and validates the functionality of the ArabicTextSanitizer function. ' It shows various test cases for sanitizing Arabic text with diacritics, non-Arabic characters, and numbers. Sub TestArabicTextSanitizer() ' Declare input and result variables Dim inputArabicText As String Dim result As String ' Example input text with diacritics, non-Arabic characters, and numbers inputArabicText = "تَجْرِبَةُ * فَاحِصِهِ # @ , لِعَمَلٍ أَلِكَوَّدِ فِىَّ شَتِّيَّ 3ألْإِشْكآل " & _ "إِشْرَافٍ عَلَى? بَعْضِ الْأَمَاكِنِ أَوْ الْمَكَانِ رَقْمٌ 5 و الْمَكَانِ رَقْمٌ 100100ِ لمعرفة كيف سيعمل ها ألكود" ' Display the original input Arabic text Debug.Print "Input Arabic Text: " & inputArabicText ' Test case 1: Remove diacritics without normalization ' This case removes diacritics (harakat) without altering normalization or removing numbers result = ArabicTextSanitizer(inputArabicText, False, False) Debug.Print "Filtered Arabic Text (case 1 - Remove diacritics without normalization): " & result ' Test case 2: Normalize and remove diacritics ' This case normalizes the text (e.g., converting similar Arabic characters) and removes diacritics result = ArabicTextSanitizer(inputArabicText, True, False) Debug.Print "Normalized Arabic Text and Removed Diacritics (case 2): " & result ' Test case 3: Remove numbers as well (Optional argument set to True to remove numbers) ' This case normalizes the text and removes both diacritics and numbers result = ArabicTextSanitizer(inputArabicText, True, True) Debug.Print "Text without Numbers and Normalized (case 3): " & result ' Test case 4: Just remove diacritics without normalization or removing numbers ' This case removes diacritics and numbers, but does not normalize the text result = ArabicTextSanitizer(inputArabicText, False, True) Debug.Print "Text without Diacritics and Numbers (case 4): " & result End Sub واخيرا اليكم مرفق للتجربة Arabic Text Sanitizer.accdb
    1 point
  45. اولا انا لا عالم ولا حتى استاذ انا اقل طالب علم ثانيا اخى القاعدة مغلقة ومحولة الى mde بهدف التأمين صاحبها لايريد لاحد الاطلاع على تصميمها مثل هذه القواعد لا يمكن لا الاستفادة منها ولا التعلم منها مطلقا ثالثا ان اردت التعلم ابحث فى المنتدى اسال حاول اجتهد وان شاء الله لا يضيع الله جهدك وان اردت التعلم من برامج مفتوحه ان وجدتها تنتهى بالامتداد mde او accde فإعلم انها مغلقة لا تسمن ولا تغنى ولن تجنى منها اى استفادة اصلا
    1 point
  46. السلام عليكم تم التعديل على ملف أخي سليم بإضافة كل الشهور في شيت واحد مع إضافة كود لإظهار الشهر المعني فقط وهذا لأجل الإحصائيات السنوية... يمكن إضافة التعديلات الأخرى الجديدة على هذا الملف... بالنسبة لأيام العطل الأخرى (غير عطلة نهاية الأسبوع) يكفي أن لا نسجل فيها الغيابات... والله أعلم أرجو أن تسهل هذه التعديلات العمل على الملف... أخوكم بن علية كشف hben.xlsm
    1 point
  47. السلام عليكم أخي الكريم إجعلها بصيغة الصفيف {} عن طريق أن تضغط (بعد الانتهاء من كتابة المعادلة في الخلية) ، تضغط Ctrl-Shift-Enter بدلا من Enter وحدها ستكون الصيغة كالتالي =LARGE($C$14:$C$36,{1;2;3;4;5}) مرفق الملف معدلا اكبر خمس قيم.rar
    1 point
  48. استاذى الفاضل دغيدى رغم اننى لا اعمل فى المرتبات ولا فى الحكومة الا اننى اتمنى ان تكون هذه الاجابة صحيحة و طريقتها كالتالى الطبقة الأولى نحذف 50 ج من المبلغ لأنها معفاة ثم الطبقة الثانية أزيد من 50 حتى 250 ج(6 فى الألف ). الثالثة أزيد من 250 حتى 500 ج (6.5 فى الألف ). الرابعة أزيد من 500 حتى 1000 ج(7 فى الألف) . الخامسة أزيد من 1000 حتى 5000 ج (7.5 فى الألف) . السادسة أ زيد من 5000 حتى 10000 ج (8 فى الألف) . كل مبلغ يزيد عن 10000 ج تخضع الزيادة لسعر 3 فى الألف . مرفق برنامج جاهز من اعمال المحاسب صلاح مدكور وبرنامج اكسيل ارفقه اخى ابوحنين ولكنه لم يشر فيه الى وجود معادله تحسب الضريبة فى العمود b البرنامج مجرب بدليل اكتب مبلغ اقل من 50 جنية لن يعطى لك مبلغ الدمغة لانها معفاه اتمن ان اكون وفقت فى تقديم معلومة مفيدة لحضرتك اخوك سعد عابد برنامج للدمغة.rar الدمغة.rar
    1 point
×
×
  • اضف...

Important Information