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

كما العنوان ومدى الدالتين: أم القـرى : بين 1317/08/29 و 1450/12/29 الميلادي : بين 1900/01/01 و 2029/05/13 طبعا لمن سيستخدمهما عليه أن يفصل أوامر فتح الإكسل وإغلاقه عن الدوال ووضعهم مع الفتح والخروج من مشروع الأكسس ، لتجنب البطء مع كل نداء للدالتين. Option Explicit Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Sub OpenxlApp() Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) End Sub Sub ClosexlApp() xlBook.Close SaveChanges:=False xlApp.Quit End Sub 'AbuuAhmed Function sysUmTest(ByVal UmAlqura As String) As String Dim Dash1 As Byte, Dash2 As Byte, Dash3 As Byte Dim Part1 As String, Part2 As String Dim Part3 As String, Part4 As String On Error Resume Next Part4 = Replace(UmAlqura, "/", "-") If Not IsNumeric(Replace(Part4, "-", "", 1)) Then Exit Function Dash1 = InStr(1, Part4, "-"): If Dash1 = 0 Then Exit Function Dash2 = InStr(Dash1 + 1, Part4, "-"): If Dash2 = 0 Then Exit Function Dash3 = InStr(Dash2 + 1, Part4, "-"): If Dash3 > 0 Then Exit Function Part1 = Left(Part4, Dash1 - 1) Part2 = Mid(Part4, Dash1 + 1, Dash2 - Dash1 - 1) Part3 = Mid(Part4, Dash2 + 1) If Len(Part1) < 4 And Len(Part3) < 4 Then Exit Function If Len(Part1) = 1 Then Part1 = Format(Part1, "00") If Len(Part2) = 1 Then Part2 = Format(Part2, "00") If Len(Part3) = 1 Then Part3 = Format(Part3, "00") If Len(Part1) = 2 Then Part4 = Part1 Part1 = Part3 Part3 = Part4 End If If Not (Val(Part1) >= 1300 And Val(Part1) <= 1600) Then Exit Function If Not (Val(Part2) >= 1 And Val(Part2) <= 12) Then Exit Function If Not (Val(Part3) >= 1 And Val(Part3) <= 30) Then Exit Function sysUmTest = Part1 & "-" & Part2 & "-" & Part3 End Function Function sysUm2Greg(ByVal UmAlqura As String) As Long Dim CurCal As VbCalendar Dim Greg As Long, Days As Long Dim Hdd As Byte On Error Resume Next UmAlqura = sysUmTest(UmAlqura) If UmAlqura = "" Or UmAlqura < "1317-08-29" Or UmAlqura > "1450-12-29" Then Exit Function Call OpenxlApp 'لتسريع الدالة يفضل نقل هذا السطر عند فتح الملف/البرنامج With xlSheet .Range("A1").NumberFormat = "m/d/yyyy" .Range("A2").NumberFormat = "0" .Range("A2").Formula = "=LEFT(TEXT(A1,""[$-1170000]B2dd/mm/yyyy;@""),2)" Hdd = Right(UmAlqura, 2) CurCal = Calendar Calendar = vbCalHijri Greg = DateSerial(Left(UmAlqura, 4), Mid(UmAlqura, 6, 2), Hdd) Calendar = CurCal .Range("A1") = Greg If Hdd = .Range("A2") Then sysUm2Greg = Greg Else For Days = Greg + 2 To Greg - 2 Step -1 .Range("A1") = Days If Hdd = .Range("A2") Then Exit For Next Days sysUm2Greg = IIf(Abs(Days - Greg) > 2, Greg, Days) End If End With Call ClosexlApp 'لتسريع الدالة يفضل نقل هذا السطر عند اغلاق الملف/البرنامج End Function Function sysGreg2Um(ByVal Greg As Long) As String On Error Resume Next If Greg < DateSerial(1900, 1, 1) Then Exit Function If Greg > DateSerial(2029, 5, 13) Then Exit Function Call OpenxlApp 'لتسريع الدالة يفضل نقل هذا السطر عند فتح الملف/البرنامج With xlSheet .Range("A1").NumberFormat = "m/d/yyyy" .Range("A2").NumberFormat = "0" .Range("A1") = Greg .Range("A2").Formula = "=TEXT(A1,""[$-1170000]B2dd/mm/yyyy;@"")" sysGreg2Um = .Range("A2") End With Call ClosexlApp 'لتسريع الدالة يفضل نقل هذا السطر عند اغلاق الملف/البرنامج End Function Sub sysUmTesting() Dim UmAlqura As String UmAlqura = "30-6-1446" Debug.Print CDate(sysUm2Greg(UmAlqura)) Debug.Print sysGreg2Um(sysUm2Greg(UmAlqura)) Debug.Print UmAlqura = "1-7-1446" Debug.Print CDate(sysUm2Greg(UmAlqura)) Debug.Print sysGreg2Um(sysUm2Greg(UmAlqura)) End Sub

أخي الكريم ..هل هذا طلبك؟!. هذا ضمن الشهر الواحد دون أن يتعدى إلى غيره من الشهور....يرجى أخذ العلم. موعد الرواتب.xlsx

mohamedyousef معقوله ده بعد كل هذا المجهود لم أرى منك اى ضغط على الإعجاب 💙 لمن كان له السبب بعد ربنا فى حل مشكلتك وتفريج كربتك وده أقل ما يقدم له نظير ذلك ؟!!!

السلام عليكم و رحمة الله اخى الكريم هى نفس المشكلة فى كل الاكواد لابد من تحديد اسم الشيت الذى تستمد منه البيانات فى الماكرو المسمى FILTERAR_CRITERIO اجعل هذا السطر Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Range("A" & Z).Value هكذا Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Sheet1.Range("A" & Z).Value و كذلك كل الاسطر التالية و المشابهة له و سيعمل معك الكود بمنتهى الكفاءة

اخي الكريم كيف تطبق الكود على بيانات مختلفة في الموقع . وجب عليك تنزيل الملف الاصلي اذا كنت غير ملم ببعض الاشياء في VBA Excel لقد قمت ببعض التعديلات لا ادري اذاكنت تريد التطبيق على العمودين E,F وهذا ما فعلته في المرة القادمة وضح اين تريد تطبيق النتائج ليس مجرد تنزيل ملفين لا احد يقوم بتتبع الكود سطر بسطر حتى يعلم ما يفعله الكود . دائما ضع النتائج قبل وبعد حتى يستطيع الاعضاء من مساعدتك. تحياتي تكلفة.xlsm

وعليكم السلام ورحمة الله تعلى وبركاته Sub Clear_Cells() Dim mh_last_row As Long Dim k As Long Application.ScreenUpdating = False mh_last_row = Cells(Rows.Count, "d").End(xlUp).Row For k = 4 To mh_last_row If Cells(k, "a").Value = "" Then Range(Cells(k, "d"), Cells(k, "f")).ClearContents Next k Application.ScreenUpdating = True End Sub كود.xlsb

تفضل اخي test_gold.xlsx

السلام عليكم 🙂 المرفق يحتوي على النسختين mdb و accdb ، ويعمل على النواتين 32بت و 64 بت 🙂 النسخة السابقة: عندما يعطي برنامج الاكسس اخطاء - النسخة رقم 3 - قسم الأكسيس Access - أوفيسنا (officena.net) بعض الاوقات عند تشغيل برنامج اكسس ، نجد انه يغلق بدون سبب ، بمثل هذه الرسالة: . او يُظهر اخطاء ، مثل هذه الرسائل وغيرها : . . . هذا معناه ان برنامجك يحتاج تنظيف من الاخطاء التي فيه ، او يحتاج الى استعادة حيويته مرة اخرى ، بالتنظيف والصيانة 🙂 وعادة نقوم بهذا العمل على برنامج الواجهات FE ، ولكن برنامج الجداول BE يستفيد منه كذلك. نافذة البرنامج : . 1. نختار الملف ، سواء mdb او accdb ، اما ملفات mde و accde ، فلن تستفيد من Decompile/Compile ، ولكنها ستستفيد من الضغط والاصلاح ، وعمل نسخ اضافية ، 2. اذا البرنامج فيه كلمة سر (ليس كلمة سر المستخدمين ، ولا كلمة سر الكود VBE) ، فيمكنك كتابة كلمة السر هنا ، وسيقوم البرنامج بحفظه/نسخه في ذاكرة الكمبيوتر ، وتستطيع استعمال الالصاق Ctl+v عندما يسألك البرنامج ، كما يقوم البرنامج بإستخدامه في فتح برنامجك لمراجعة الاخطاء. اذن هناك خطوة يمكن للبرنامج ان يستخدم كلمة السر مباشرة ، وهناك خطوة يجب عليك ادخال كلمة السر عن طريق اللصق Ctl+v ، تم إضافة ميزة عمل النسخ الاحتياطية لبرنامجك ، بحيث تحفظ نسخة من برنامجك بعد التنظيف ، في المجلد الذي تختاره ، ويكون الحفظ المسلسل هكذا : . يعني بدل ان تحفظ نسخة من برنامجك بطرقك الخاصة ، تستطيع وبعد تعديل برنامجك ، ان تتأكد انه خالي من الشوائب ، ويعمل نسخه منه تلقائيا 🙂 وهناك عدة طرق لإختيار مجلد الحفظ: 3. حفظ الملف في نفس مجلد البرنامج ، 4. اختار المجلد ، وبعد اختياره ، تستطيع ان تنقر على الزر 9 ليقوم البرنامج بحفظ هذا المجلد/المسار في البرنامج للمرات القادمة ، 5. اول مسار تريد حفظه هو: استعمل الخطوة 4 في فتح المجلد الرئيسي لحفظ النسخ الاحتياطية (واذا ما كان عندك ، فقم بعمله من الآن) ، ثم احفظ المجلد/المسار بالزر 9. وبعدها ، البرنامج تلقائيا يختار هذا المجلد (اذا قمت بحفظه بواسطة الزر 9) كلما فتحت البرنامج ، اي انه اول سجل في الجدول ، 6. عن طريق الخطوة 4 ، تستطيع حفظ اي عدد من المجلدات ، ولاحقا تستطيع ان تختار هذا المجلد لحفظ النسخة الاحتياطية فيه ، 7. عدم عمل نسخ احتياطية ، للأسف الشديد 😞 8. عند اختيار اي من الاختيارات اعلاه ، سيضع البرنامج مسار مجلد النسخ الاحتياطية هنا ، 11. الآن نطلب من البرنامج ان يقوم بعمله ، بالخطوات التالية : أ. يحفظ نسخة من البرنامج وقبل مساسه (حتى اذا لا قدر الله وحصلت مشكلة في العمل ، يمكنك الرجوع لهذه النسخة) ، ويقوم البرنامج بعمل النسخة في مجلد برنامجك ، بإضافة bak_ في نهاية اسم الملف ، كما في الصورة ، واذا احتجت لإستعمال الملف لاحقا ، فقط قم بحذف bak_ وسيعمل البرنامج : ب. ضغط واصلاح : لما تحذف سجلات من برنامجك ، فإن البرنامج يعطي اشارة الى الجدول بإخفائه ، ولا يقوم بحذفه إلا بعد الضغط والاصلاح ، عند عمل فهرسة لحقول في الجدول ، فإن البرنامج يحتاج الى ضغط واصلاح حتى يقوم بترتيب اعدادات الفهرسة ، عند العمل على البرنامج لفترة طويلة بإضافات وتعديل وحذف ، فالبرنامج يحتاج الى ضغط واصلاح لإعادة ترتيب الفهرسة لسرعة عمل البرنامج ، قد يتم خطأ في تسجيل سجل ، ربما بسبب انطفاء الكهرباء ، او اغلاق الكمبيوتر وبدون اغلاق البرنامج ، وهذا السجل يجعل الجدول لا يعمل بطريقة صحيحة ، والضغط والاصلاح يحل هذه الاشكالية ، البرنامج عبارة عن ملف في الكمبيوتر ، ولما تعمل البرنامج ، فإن الكمبيوتر يحفظ البرنامج على المكان الفارغ من القرص الصلب ، ولما تضيف سجلات جديدة ويكبر حجم البرنامج ، فقد يحفظ الكمبيوتر الجزء الجديد في مكان آخر على القرص الصلب ، مكان غير ملاصق للجزء الاصل (وهذه طريقة حفظ الكمبيوتر للملفات) ، وبهذه الطريقة يصبح الملف موجدا على اجزاء مختلفة من القرص الصلب ، مما يجعل البرنامج ابطأ ، ولما تعمل ضغط واصلاح ، فإن الاكسس يقوم بحساب المساحة المطلوبة للبرنامج ، ثم يقوم بعمل برنامج جديد في مكان جديد على القرص الصلب ، وينسخ البرنامج اليه ، مما يجعل البرنامج اسرع ، بالاضافة الى امور اخرى لا يتم حلها إلا بالضغط والاصلاح ، الضغط والاصلاح لا علاقة له بالكود ، ولا يقوم بفحصه. ج. Decompile : لما نكتب الكود ، الاكسس يحتفظ بكل سطر بلغة P-Code الخاصة بمايكروسوفت (والتي تُستخدم لبعض البرامج الاخرى كذلك) ، وعند تنفيذ الكود ، فالاكسس ينفذ كود لغة P-Code ، وفي بعض الاحيان من كثرة التعديلات على الكود ، فإنه لا يتم تحديث P-Code بطريقة صحيحة ، فينتج عنه رسائل اخطاء اكسس ولا يعمل البرنامج بطريقة صحيحة ، وعند عمل Decompile ، فالاكسس يحذف كود P-Code القديم ، ويسجل فيه كود جديد من VBA ، مما يجعل البرنامج اصغر في الحجم زيادة في الكفائة. د. Compile : بهذه الطريقة ، نتأكد من عدم وجود اخطاء في الكود ، وبقايا ومخلفات ، مثل: لما نحذف كائنات في النموذج/التقرير ، ولا نحذف الحدث الخاص بها ، فالكود يجب حذفة ، لعدم وجود الحدث الي يستعمله ، لما نحذف كائن في النموذج/التقرير ، وفي الكود نكون قد اعطيناه قيمة ، فيجب حذف المسمى من الكود ، عند كتابة كود بطريقة غير صحيحة وغير مكتملة ، فيجب تصحيحها ، وهذه الخطوه مهم لتحويل البرنامج الى mde او accde . يحاول البرنامج القيام بهذا العمل لبرنامجك ، ولكنه اذا لم يستطيع ويحصل على اخطاء ، فإنه يخبرك بهذا ، ويخبرك مكان الخطأ في الكود ، سواء وحدة نمطية او نموذج او تقرير ، ويعطيك مثل الرسالة التالية ، والتي اذا اخترت نعم ، فيوقف البرنامج ، . ويأخذك لبرنامجك الى نافذة الكود VBE ، ثم يجب عليك ان تعمل التالي يدويا: . وتُصلح الاخطاء التي في برنامجك ، الى ان لا يعطي برنامجك اخطاء اخرى ، وبعدها تستطيع ان ترجع الى البرنامج ليقوم جميع الخطوات مرة اخرى. هـ. اذا اشتغلت خطوات البرنامج وبدون اخطاء ، فهنا يقوم البرنامج بعمل نسخة احتياطية من برنامجك ، وبالتسلسل الصحيح ، وفي المجلد الذي اخترته. 12. البرنامج يخبرك عن الخطوات التي تمت 🙂 جعفر Decompile_4.accdb..zip Decompile_4.mdb..zip Decompile_4.2.accdb.zip

توضيح اكثر 9.35E+1=93.5 9.35E+2=935 9.35E+3=9350 9.35E+5=935000 وهكذا هذا رابط لفيديو بخصوص الموضوع https://youtu.be/vlWqr9RYzyE

شكر وتقدير واحترام من اخيك

وعليكم السلام ورحمة الله تعالى وبركاته نعم اخي لازم تقوم بتعديل المعادلة على حسب متطلباتك بتغيير الارقام كما في الصورة المرفقة وعليها مثال لطلبك Book1.xlsx

لم أفهم كلامك جيدا ، الخلاصة أنك لا تريد نتائج أصغر من صفر ، صحيح؟ موعد الرواتب_03.xlsx

السلام عليكم ورحمة الله الف شكر يا استاذي على المساعدة فعلا هو ده المراد عمله الف شكر مرة ثانية الشلام عليكم

جزاك الله خسر الثواب وأكرمك الله وأحسن الله اليك

كود لتكبير الخلية النشطة فقط Book1.rar

السلام عليكم و رحمة الله ..فى كود الفلترة حول هذه الكلمة ActiveSheet الى Sheet1..و ينتهى الامر باذن الله

اربطهم بجدول مؤقت تسجل فيه الفاتورة ثم عند الاضافة تنتقل البيانات الى جدول الفواتير ثم يتم افراغ الجدول المؤقت

وعليكم السلام ..هل هذا ما تقصده ؟! ولكن كل هذا بمقابل مادى وليس ببلاش !! https://superuser.com/questions/351494/show-excel-sheet-tab-in-≥-2-rows

فيديوووووو جديددددد كيفية اضافة شيت جديد باسم الموظف ورقمه باستخدام VBA في الفيديو ده هانتعلم ازاي نضيف شيت جديد بواسطة كود فيجوال بيسك واستخدامه في اي برنامج انت هاتشتغل فيه وانا سايبلك الملف في جوجل درايف ممكن تحمله من هناك ولازم تطبق الفيديو