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

Sub test() Dim a With Sheets("DataT1").Cells(1).CurrentRegion a = .Value With Sheets("GradesT1") .Cells(1, 1).Resize(UBound(a), 5) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), [{1,5,3,4,7}]) End With: End With End Sub عسى ولعل تم نقل خمسة أعمدة وبالترتيب الذي تختاره أنت

اهلا اخوي @Moosak يمكن من الاصدار ، والا فالمثال لا يوجد الا فنكشن بسيط تفضلوا غيرت قاعدة البيانات الى الاصدار 2010 المرفق في المشاركة الاخيرة

Macros in Microsoft Access are limited to a specific set of actions that can be performed, and may not support all of the functionality that is available in VBA. For example, macros cannot use variables or functions, and may not support certain types of control structures such as loop

Private Sub CommandButton4_Click() Dim i As Long Dim WS As Worksheet Set WS = Worksheets("مخزن (2024)") With WS r = .Columns(2).Cells.Find(Me.TextBox2, , , 1).Row For i = 2 To 12 .Cells(r, i) = UserForm1.Controls("Textbox" & i).Value UserForm1.Controls("Textbox" & i).Value = "" Next End With End Sub

جزاكم الله خيرا 🌹 لم اقم بحفظ اسم الملف نظرا لان الكود القديم كان يقوم بعمل حفظ للمرفق برقم ال ID لذلك لم تستدعى الحاجه لإضافة بيانات وحقل بلا داعى 😉

يعمل زي الحلاوة بالطحينة يا مولانا ... ربنا يبارك فيك 🙂 بس بعد أذنك ياهندسة أجريت تعديلات بسيطة على الكود علشان يحفظ اسم الملف في الجدول وليس الإكستنشن فقط . ويحذف اسمه من الجدول بعد حذف الملف. مرفق بجانب البرنامج.accdb

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

هذا مثال ..وبصراحة لم افهم قصدكم مع الاستاذ الحلبي isDate.rar

تم رفع اشعار لادارة وفريق الموقع

بالنسبة لنا في السعودية يوجد اكثر من قناة لتوصيل التبرعات ومن اهمها وآمنها في وصول التبرعات الى مستحقيها وهي منصة ساهم التابعة لمركز الملك سلمان للإغاثة والأعمال الإنسانية . مركز الملك سلمان للإغاثة ///// التبرع لمساعدة ضحايا الزلزال في سوريا وتركيا من خلال #منصة_ساهم عبر الرابط الآتي: https://sahem.ksrelief.org/SYTR

المشكلة هذه ضبطها من الاتجاه في الخصائص يضبط الاتجاه يمينا او يسارا في النموذج ومثلها في الازرار وجميع العناصر

على كل حال غدا سأرفع النسخة المفتوحة ولكن يهمني محاولة ورأي من يهمه الأمر جرب آخر مرفق هنا عند تحويل قاعدة البيانات الى Accde او mde لا يمكن الاطلاع على الاكواد

أأأأأه هذه معلومة جديدة لدي

مأجور ابا جودي .. انالك الله البر بوالدتك .. اخي العزيز ابا جودي ، لا بد تطلع على المثال وتقيم الحماية انا اعتبرها حماية مؤقتة منفصلة تنتهي عند الشراء ، لعلك قرأت اعلاه شرحي للفكرة

استدراك لم آخذ بالاعتبار امكانية التلاعب بتغيير التاريخ بالامثلة السابقة لأني كنت افكر باستخدام الانترنت لجلب التاريخ العالمي ، وغفلت عن ضبط هذه النقطة اليكم المثال بعد التعديل اتمنى احد منكم بعد الساعة الثامنة غدا ان يتمكن من فتح النموذج

السلام عليكم ورحمة الله تعالى وبركاته. تفضل اخي ربما تقصد ترحيل البيانات بشرط الإسم الموجود في الخلية M3 اليك حل آخر بالمعادلات . INDIRET COSTS 2023_V1.xlsx

استاذي الخلوق كل الشكر والتقدير كود ولا اروغ دمت بحفظ الله وامنه

وعليكم السلام ورحمه الله وبركاته جرب هذا التعديل Test.xlsb

جميل جدا استاذنا / احمد ويا حبذا لو فيه حقل اخر عبارة عن تاريخ ونطبق نفس العمل استاذنا ومعلمنا / قاسم ياريت تضيف حقل اخر عبارة عن تاريخ وتطبق كود حضرتك تجد ان نفس الرسالة المزعجة تظهر ارى من الاصلح ان يكون هناك حقلين ـ حقل رقمى ـ حقل تاريخ ـ ثم نطبق الاكواد جزاكم الله خيرا على ما تقدمونه لنا

السلام عليكم محاولة بالكود ارجو فيها الفائدة قائمة الاسماء في العمود A يقوم الكود بتحديثها تلقائيا بمعنى عند اظافة اي اسم جديد في العمود F3يقوم الكود باظافتها في الليست في M3 لا تنسى تمكين المحتوى تحياتي INDIRET COSTS 2023.xlsb

عمي @ابوخليل 🙂 المرفق يشتغل على 32 بت فقط ..

لغتي الانجليزية جيدة ولكن العربية عشق واعتزاز وفخر

وعليكم السلام ورحمة الله وبركاته تفضل Sub test() Dim X X = Application.Match(range("c5"), Columns(7), 0) If Not IsError(X) Then Cells(x , "H") = range("D5").Value Else Msgbox "لا يوجد هذا الاسم" End if End sub

وعليكم السلام ورحمة الله وبركاته جرب هذا التعديل تم اضافه next i في السطر الرابع من اسفل الكود Private Sub CommandButton5_Click() Dim WS As Worksheet, LastRow As Long Set WS = ThisWorkbook.Sheets("ãÎÒä (2024)") If TextBox2.Text = "" Then MsgBox "Þã ÇæáÇ ÈÇÎÊíÇÑ ãæÙÝ áÊÚÏíáå Çæ ÍÐÝå", vbExclamation, "ÍÐÝ" Exit Sub End If LastRow = WS.Cells(Rows.Count, "B").End(xlUp).Row + 1 Dim Q Q = MsgBox(" ÃäÊ Úáì æÔß ÍÐÝ ÇáÇÓã " & " ( " & TextBox2.Text & " ) " & " ãä ÇáÓÌá ¡ åá ÊÑíÏ ÇáãæÇÕáÉ ", vbCritical + vbYesNo, "ÊÃßíÏ ÇáÍÐÝ") If Q = vbYes Then For i = 2 To 12 For T = 2 To LastRow If TextBox2.Text = WS.Cells(T, 2) Then With WS .Cells(T, i).Value = "" .Rows(T).Delete Shift:=xlUp End With End If Next t Next i MsgBox " áÞÏ Êã ÍÐÝ ÇáãæÙÝ " & TextBox2.Text & " ãä ÞÇÚÏÉ ÇáÈíÇäÇÊ ", vbInformation, "" End If For i = 2 To 12 Me.Controls("TextBox" & i).Value = "" next i Me.ComboBox1.Clear TextBox2.SetFocus End Sub

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

ملحوظة : عند فتح المثال لأول مرة يجب ربط الجدول الواجهة بجدول القاعدة الخلفية

تفضل اخي الكريم في المرفق نموذج وجدول يشتمل على حقل واحد سوف يفتح معك خلال الــ 24 ساعة القادمة .. بعدها لن تتمكن من فتح الفورم والبرنامج سوف يغلق تلقائيا كلمة السر لفتح البرنامج تجدها في الجدول .. لذا حاول ان تفك التشفير انتبه !! اذا اختل النص المشفر فلن يمكنك فتح الفورم ايضا ، فقبل العبث به قم بنسخه ولصقه بعيدا كي ترجع اليه عند حاجتك لفتح الفورم الفكرة .. هي ان يكون الفورم هذا هو فورم البداية في النسخة المؤقته .. بعد تجربة العميل وموافقته على شراء البرنامج ترسل اليه نسخة من الواجهات مفتوحة ولا تحتوي على هذا الفورم المشفر ولا جدول التشفير وانما تحتوي على ادوات الحماية المعروفة لعدم استخدام النسخة في اجهزة اخرى . وهذا يعني ان النسخة التجريبية لا تحتوي على اي نوع من انواع الحماية سوى هذا التشفير المثال على صيغة mde المثال المفتوح سوف ارفعه بعد اقتناعك بقوة الحماية مع بساطتها المرفق في آخر مشاركة

الافضل ينقل الموضوع الى القسم المفتوح في الموقع ليطلع عليه اكبر شريحة من مرتادي الموقع ايضا يتم اشعار مدير الموقع للمشاركة وابداء الرأي

تفضل جرب اخي اسم المستخدم: admin كلمة المرور : 12345 Private Sub CommandButton1_Click() Dim sh As Worksheet Set sh = Sheet1 Dim lr As Long lr = sh.Range("A" & Rows.Count).End(xlUp).Row '''''''''''''''Validation''''''''' With sh .Cells(lr + 1, "A").Value = Me.TextBox2.Text .Cells(lr + 1, "B").Value = Me.TextBox3.Text .Cells(lr + 1, "C").Value = Me.TextBox4.Text .Cells(lr + 1, "D").Value = Me.TextBox5.Text .Cells(lr + 1, "E").Value = Me.TextBox6.Text .Cells(lr + 1, "F").Value = Me.TextBox7.Text .Cells(lr + 1, "G").Value = Me.TextBox8.Text .Cells(lr + 1, "H").Value = Me.TextBox9.Text .Cells(lr + 1, "i").Value = Me.TextBox10.Text .Cells(lr + 1, "j").Value = Me.TextBox11.Text .Cells(lr + 1, "k").Value = Me.TextBox12.Text End With For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i ListBox1.ColumnCount = 11 ListBox1.RowSource = "A1:K100000" MsgBox "تمت اضافة البيانات بنجاح" End Sub قاعدة بيانات1.xlsm

1- البرنامج يعمل تمام بدليل اني بعدل عليه . 2- تفضل حسب طلبك الاخير طبعاً سيتعامل السجلات التي مسجل بها التاريخ المدة من . DRelayDataByDate-1.rar

اتفضل وهذا المرفق الجديد وان شاء الله يعمل على كلتا النواتان 32X , 64X وبدون اى مشاكل نسخه من مرفق (2).accdb

وعليكم السلام.. عن اذن استاذ احمد...استخدم دالة IsDate If Not IsDate(Me.dateTextBox) Then MsgBox "الرجاء ادخال التاريخ" Me.dateTextBox.SetFocus End If

بارك الله فيك اخي وجزاك الله كل خير لقد وجدت الحل

تفضل اخى Sub Merge_Sheets() Dim Sht As Worksheet Dim Sht6 As Worksheet Dim LastRow6 As Long Dim Rng As Range Set Sht6 = Sheets("DataT1") 'Loop though B1DataT1 - B2DataT1 - B3DataT1 For Each Sht In Sheets(Array("B1DataT1", "B2DataT1", "B3DataT1")) 'Find last row LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Determine lastrow on DatatT1 LastRow6 = Application.Max(3, Sht6.Cells(Rows.Count, 1).End(xlUp).Row + 1) 'Set Range Set Rng = Sht.Range("A3:Q" & LastRow) 'Copy to DataT1 Rng.Copy Destination:=Sht6.Range("A" & LastRow6) Next End Sub ولا تنسي ان تمسح البيانات الموجوده في الشيت Sht6 لان بها بيانات تتعدى ال ٣٠٠٠ السطر

شكرا استاذ دربالي على جهودك انا لم اطلع عليه ، ومادام مفتوح المصدر كما ذكرت ، فجميل ان يطلع عليه المتعلم لزيادة معرفته بأمور الحماية

لا مشكلة ولا شيء العدل اساس الحكم كلهم يأخذوا مكرر ... اين المشكلة في ذلك عندي طالبين ( محمد / علي )اخذوا الدرجة نفسها في المركز الثاني ... النتيجة محمد = الثاني مكرر ، علي = الثاني مكرر وهكذا لو تساوى العشرة كلهم في درجة واحدة سيصبحوا كلهم : العاشر مكرر واعطاء الاولوية بالعمر او الابجدية ظلم ... خاصة الابجدية اذا مررنا العمر علما ان الطلبة غالبا متقاربين فالذي سن هذا القانون اسمح لي انه لم يوفق لا باس ان يكون هناك ترتيب في الكشف حسب العمر او الابجدية ولكن ترتيب التقدير تأثيره قوي

قمت بانشاء فيديو على عجالة امل الاستفادة https://youtu.be/MJkDD1nK7l8

لطفا ارفق ملف