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

كما العنوان ومدى الدالتين: أم القـرى : بين 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

تفضل اخي test_gold.xlsx

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

السلام عليكم 🙂 المرفق يحتوي على النسختين 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

أحسنت أستاذنا الكريم وبارك الله فيك .. طبعاً موضوع مهم وقيم , جعله الله فى ميزان حسناتك

اشكرك اخى الكريم هذا هو المطلوب بالطبع شكرا جزيلا

وعليكم السلام ..تفضل أخي الكريم =IF(SUM(I4:I10)<=100;SUM(I4:I10);"خطأ") الملف هنا بعد التحديث التلقائي. ملف تصورى.xlsx

أخي تدخلي لحل مشكلة البطء ولم أتدخل في العمليات الحسابية. الحل الأخير لا يمكن مقارنته بما سبق ، فحلي كان لمشكلة تقنية تحتاج إلى انتباه وقد وجهت لكم نصيحة في مشاركة سابقة لي ولم تلتفتوا إليها وكان بها نصف الحل. المشكلة كانت اختياركم للحدث الخطأ والآخر هي مشكلة تكرار الحدث مع كل عملية تحديث للخلايا وقد تم تغيير الحدث وتم تعطيل الحدث أثناء العمليات الحسابية. أما شفرات الحسابات فهي شفرات احترافية لا شك وخصوصا تصميم حلقات التكرار ومع ذلك اختصار الشفرة وجمالها لا تصلح المشكلة فعدد العمليات هي نفسها سواءً كانت الشفرة بألف سطر أو بعشرة مع الحلقات. وأنا بالتأكيد مع الحلقات الذكية والتنظيم الجميل لها. على محترفي الإكسل والشفرات النظر للأمثلة ومقارنة أدائها واخبارنا بالتقييم الصحيح ، وشكرا للجميع. ملاحظات : - حل تكرار الحدث تمكنت من التغلب عليه في موضوع آخر "بالتحايل" ولكن في هذا الموضوع تم حله بالشكل البرمجي الصحيح بعد عمليات بحث مكثفة. - سامحني لا أتمكن من المتابعة لمشكلة العمليات الحسابية ونتائجها ، موفقين دائما.

الحمد لله تم التوصل الى الكود If .Cells(r, "e").Value <= CDate(TextBox5.Value) And .Cells(r, "j").Value = "" Then واعتقد انه حل الامر وافر التحية للجميع

9.35 × (عشرة اس 41) توضيح اكثر هذا الرقم كبير جدا يتكون من 41 خانة بعد الفاصلة العشرية ظهر لنا بعد الفاصلة خانتين هما 35 باقي 39 خانة كلها اصفار

وعليكم السلام اخي العزيز افتح موضوع جديد ..وستتم اجابتك ان شاء الله

تضل اخي الفاضل هدا كود اخر لانشاء ورقة جديدة وتسميتها باخر قيمة موجودة على عمود A Sub Bouton1_Cliquer() Dim lastLine As Integer Dim NameSheet As String Dim MH As Boolean lastLine = ThisWorkbook.Sheets("toutal").Range("A" & Rows.Count).End(xlUp).Row NameSheet = ThisWorkbook.Sheets("toutal").Range("A" & lastLine) MH = feuilleExiste(NameSheet) If MH = True Then MsgBox "يتعذر انشاء ورقة جديدة بسبب وجودها مسبقا او خانة الاسم فارغة", vbInformation Else Worksheets("hakan").Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = Worksheets("toutal").Cells(Rows.Count, 1).End(xlUp).Value ThisWorkbook.Sheets("toutal").Activate End If End Sub Function feuilleExiste(FeuilleAVerifier As String) As Boolean On Error Resume Next ThisWorkbook.Sheets(FeuilleAVerifier).Name = Sheets(FeuilleAVerifier).Name feuilleExiste = (Err.Number = 0) End Function mango_MH4.xlsm

أخطأت في رابط المثال الذي يضم 3 طرق حساب الترقيات

أخبرتكم أن النسخة السابقة هي الأخيرة ولكن سيطرت علي فكرة في الوصول إلى تاريخ أم القرى بدون فرق ، وقد نجحت الفكرة والحمد لله. سأطبقها إن شاء على مثال للأكسس الحقوق الفكرية محفوظة 🙂 كشف انتهاء هويات الموظفين_05.xlsm

معادلة أخرى موعد الرواتب_02.xlsx

جرب الآن وارجع لنا بالنتيجة ..مع ملاحظة أني لعبت في البيانات نمودج_02.xlsb

المشكلة في تنسيق الخلايا المثال.xlsx

السلام عليكم ورحمة الله فى الكود المسمى Public Sub cargar_cambobox ... استبدل هذه العبارة Me.ComboBox1.RowSource = Range("k1:k12").Address بتلك العبارة Me.ComboBox1.List = Sheet1.Range("k1:k12").Value

السلام عليكم ورحمة الله تعالى وبركاته ..تفضل اخي جرب تم تعديل صيغة الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim e As Integer Dim LastRowInSheet As Long Dim d As Variant Dim f As Variant Dim InputArray As Variant Application.ScreenUpdating = False LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row InputArray = Range("A1:N" & LastRowInSheet) e = d + f For d = 4 To 99 For f = 100 To 1000 Step 100 InputArray(d, 1) = InputArray(d, 3) - InputArray(d, 2) + InputArray(d - 1, 1) InputArray(d, 12) = InputArray(d, 11) * InputArray(d, 10) InputArray(d, 14) = InputArray(d, 13) * InputArray(d, 10) InputArray(d, 10) = InputArray(d, 9) * InputArray(d, 8) InputArray(d + f - 3, 1) = InputArray(d + f - 3, 3) - InputArray(d + f - 3, 2) + InputArray(d + f - 4, 1) InputArray(d + f - 3, 12) = InputArray(d + f - 3, 11) * InputArray(d + f - 3, 10) InputArray(d + f - 3, 14) = InputArray(d + f - 3, 13) * InputArray(d + f - 3, 10) InputArray(d + f - 3, 10) = InputArray(d + f - 3, 9) * InputArray(d + f - 3, 8) Next Next Range("A1:N" & LastRowInSheet) = InputArray Application.ScreenUpdating = True End Sub نمودج-2.xlsb

Have a look. Is that the desired output

هذا الملف يساعد فى تحليل نتائج تحليل دانكن البعدي و التحليلات البعدية Post Hoc هي التي نلجأ اليها فى حالة كانت نتيجة اختبار الانوفا أنه يوجد فروق معنوية ، فنتجه لهذه التحاليل للتعرف على مصدر الفروق بناء على اختبار ليفيني للتجانس نقرر اي مجموعة من الاختبارات البعدية نتبع ، فهناك مجموعتان كما هو موضح فى الصورة ، الاولي تفترض وجود تجانس و الثانية لا تفترض ذلك ، و اختبار دانكن هو من اشهر اختبارات المجموعة الاولى و ارجو ممن لديه خبرة بالتحليل المراجعة و الاضافة أو التصحيح ان لزم الامر Duncan.xlsx

مجرد فضول اختي الكريمة لماذا العمود F في الورقة Transaction البعض قيم مدخلة يدويا والبعض يحتوي على معادلات هل يتم ادخال الارقام يدويا ام يتم جلبها بواسطة المعادلات ؟