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

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

وهذه مشاركة مع اساتذتي الكرام ... مع التحية لهم جميعا ..... If DCount("*", "[Students]", "[ID]=" & Me.Text0) > 0 Then Dim rst As DAO.Recordset Dim fld As Field Dim a As Integer Set rst = CurrentDb.OpenRecordset("SELECT Students.ID, Students.Fullname, Students.tel, Students.Degree, Students.class " & _ "FROM Students " & _ "WHERE (((Students.ID)=" & [Forms]![Form]![Text0] & "));") For a = 1 To rst.RecordCount For Each fld In rst.Fields If IsNull(fld.Value) Then MsgBox "قم باكمال البيانات" & "(" & fld.Name & ")" & "ليس هناك بيانات في الحقل" DoCmd.OpenQuery "استعلام1", acViewNormal Exit Sub End If Next fld rst.MoveNext Next a rst.Close: Set rst = Nothing DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO Team ( ID, Fullname, tel, Degree, class ) " & vbCrLf & _ "SELECT Students.ID, Students.Fullname, Students.tel, Students.Degree, Students.class " & vbCrLf & _ "FROM Students " & vbCrLf & _ "WHERE (((Students.ID)=[Forms]![Form]![Text0]));" DoCmd.SetWarnings True Me.Text0 = "" Else MsgBox "هذا القيد غير موجود" End If Me.Requery Me.Text0 = Null Me.Text0.SetFocus Example.accdb

شرح فورم الاكسل للجداول الجاهزة الدخول بسرى وفورم اضافة وتعديل وحذف فيديو3 الفيديو

ما شاء الله ربي يعطيك الف عافيه ويبارك فيك

الشكر وحده لايكفيك حقك اخى موسى حفظكم الله وبارك لك فى مالك وال بيتك وزادك من فضله اللهم امين يارب العالمين

الشكر لله ثم لاخوانننا واساتذتنا جزاهم الله عنا كل خير اتفضل التعديل على تعديلك لكود اخى واستاذى @kanory جزاه الله خيرا Private Sub Command2_Click() If DCount("*", "[Students]", "[ID]=" & Me.Text0) > 0 Then Dim rst As DAO.Recordset Dim fld As Field Dim a As Integer Set rst = CurrentDb.OpenRecordset("SELECT Students.ID, Students.Fullname, Students.tel, Students.Degree, Students.class " & _ "FROM Students " & _ "WHERE (((Students.ID)=" & [Forms]![Form]![Text0] & "));") For a = 1 To rst.RecordCount For Each fld In rst.Fields If IsNull(fld.Value) Then MsgBox "فارغ " & fld.Name & " حقل", vbOKOnly + vbMsgBoxRight, "انتبه" End If Next fld rst.MoveNext Next a rst.Close: Set rst = Nothing End If End Sub بالتوفيق

ممكن توضح اكثر (لان سؤالك مبهم جدا) لان لو انت تريد ان تظهر علامة "%" فى الجدول فقط ضع هذا التنسيق واذا كنت تريد ان تستخرج قيمة نتيجة النسبه من المبلغ 200 مثلا على فرضا ان النسبه هى 11% يجب ان يكون الناتج 22 ويمكن تطبيقها هكذا فى حقل محسوب (لا يفضل ان تجعل فى الجداول حقول محسوبه لانها تثقل من اداء القاعده مستقبلا وتكون ثقيله فى العمل)(يمكن تطبيقها مثلا فى النماذج او الاستعلامات افضل) [مبلغ العقد]*[اطلاق نسبة من العقد] طبعا هى هكذا علشان احنا وضعنا تنسيق الحقل انه قيمة مئاوية (%) اما اذا كان تنيق الحقل رقمي عادي هيكون هكذا [مبلغ العقد]*[اطلاق نسبة من العقد]/100 اما لاستخراج قيمة النسبه ال 22 من ال 200 هتكون هكذا (مبلغ النسبه ال هو 22 مضروب فى 100 مقسوم على اصل المبلغ ال هو 200 هيطلعلى النسبه وهى 11 اتمنا ان اكون قد اصبت [مبلغ النسبة]*100/[مبلغ العقد]

يمكن اختصار: n = IIf(IsNull([Text0]), 0, [Text0]) إلى: n = Nz(Me.Text0), 0) ويمكن لمزيد من الاختراز تبديل: If IsNull(fld.Value) Then إلى: If Trim(Nz(fld.Value, "")) = "" Then مع الإعتذار لكاتب الأكواد فهي صحيحة ولكن صيغت أولها للإختصار والأخرى لمزيد من الإحتراز.

جرب استعمال هذi المعادلة في الخلية B10 =IF($C$3+ROW()-10>=$C$3+$C$6,"",$C$3+ROW()-10) مع سحب المعادلة لأسفل بالتوفيق

أضرب الوقت في 24 ستحصل على الرقم العشري والعكس اقسم الرقم العشري على 24 ثم استخدم تنسيق الوقت.

قم فقط بتغيير إسم شيت قاعدة البيانات للإنجليزية ونسخ الإسم فالكود.

بدات فعلا في عمل استعلامات استخرج بيها البيانات من جدول الفواتير ١-قيمه المبيعات توجه علي حساب المبيعات ٢- قيمه الضريبه توجه علي حساب الضريبة ٣ - اجمالى قيمه الفاتور الي حساب العملاء و عملت ٣ استعلامات الاحاق عن طريق الاستعلامات السابق في الجدول و عملت استعلام حذف في حالت التعديل و لسه بكمل شكرااا جداا لحضرتكم

وعليكم السلام ورحمة الله وبركاته زادك الله من علمة و بارك الله فيك 👍

السلام عليكم ورحمه الله وبركاته مشاركه مع اخى واستاذى ووالدى الحبيب @مبرمج سابق جزاه الله عنا كل خير 💐🌹 وعلى الرغم باننى لست احد الاساتذه فقد احببت مشاركتكم للتعلم والاستفاده فقد مزجت بين كود معلمى ووالدى الحبيب وبين الكود السابق بالمثال لرغبه الاخ السائل الكود التالى والمرفق بالمثال Private Sub Command2_Click() Dim n As Integer n = IIf(IsNull([Text0]), 0, [Text0]) If DCount("*", "[Students]", "[ID]=" & n) = 0 Then MsgBox "هذا القيد غير موجود": Exit Sub Dim rst As Recordset Dim fld As Field Set rst = Me.RecordsetClone rst.FindFirst "[ID]=" & [n] For Each fld In rst.Fields If IsNull(fld.Value) Then MsgBox fld.Name DoCmd.OpenForm "frm_Stud", , , "[id]=" & [n] Exit Sub End If Next fld DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO Team ( ID, Fullname, tel, Degree, class ) " & vbCrLf & _ "SELECT Students.ID, Students.Fullname, Students.tel, Students.Degree, Students.class " & vbCrLf & _ "FROM Students " & vbCrLf & _ "WHERE (((Students.ID)=[Forms]![Form]![Text0]));" DoCmd.SetWarnings True Me.Text0 = "" Me.Text0.SetFocus End Sub وتعديل بسيط ع كود معلمى ووالدى الحبيب جزاه الله عنا كل خير وهو اخراج جزء الاضافه لما بعد فحص الحقول Private Sub Command2_Click() Dim n As Integer n = IIf(IsNull([Text0]), 0, [Text0]) If DCount("*", "[Students]", "[ID]=" & n) = 0 Then Exit Sub Dim rst As Recordset Dim rs As Recordset Dim fld As Field Set rst = Me.RecordsetClone Set rs = CurrentDb.OpenRecordset("team") rst.FindFirst "[ID]=" & [Text0] For Each fld In rst.Fields If IsNull(fld.Value) Then MsgBox fld.Name DoCmd.OpenForm "frm_Stud", , , "[id]=" & [Text0] Exit Sub End If Next fld rs.AddNew rs.Fields(0) = rst.Fields(0) rs.Fields(1) = rst.Fields(1) rs.Fields(2) = rst.Fields(2) rs.Fields(3) = rst.Fields(3) rs.Fields(4) = rst.Fields(4) rs.Update rs.Close: rst.Close Set rs = Nothing: Set rst = Nothing End Sub تقبلوا تحياتى ومرورى Example_1.accdb

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

نعم اخي وان كنت افضل ان يكون الحل مقدم من احد اساتذة الموقع او الخبراء الافاضل نعود للموضوع المطلوب نقل سجلات الطالب من جدول الى اخر عن طريق رقم الطالب والتأكد بعدم وجود حقول خاليه خلال عمليه النقل الفكرة على النحو التالي مع التأكيد بان الكود يمكن اختصاره في زر الامر نقل وضعنا الكود التالي Dim n As Integer n = IIf(IsNull([Text0]), 0, [Text0]) If DCount("*", "[Students]", "[ID]=" & n) = 0 Then Exit Sub Dim rst As Recordset Dim rs As Recordset Dim fld As Field Set rst = Me.RecordsetClone Set rs = CurrentDb.OpenRecordset("team") rst.FindFirst "[ID]=" & [Text0] For Each fld In rst.Fields If IsNull(fld.Value) Then MsgBox fld.Name DoCmd.OpenForm "frm_Stud", , , "[id]=" & [Text0] Exit Sub Else rs.AddNew rs.Fields(0) = rst.Fields(0) rs.Fields(1) = rst.Fields(1) rs.Fields(2) = rst.Fields(2) rs.Fields(3) = rst.Fields(3) rs.Fields(4) = rst.Fields(4) End If Next fld rs.Update rs.Close: rst.Close Set rs = Nothing: Set rst = Nothing السطر 1 و 2 و3 الغرض منها ايقاف تنفيذ الامر في حالة كون رقم الطالب غير صحيح او ان حقل البحث فارغ ويمكن استبدالها بامر معالجة الاخطاء الاسطر 4 و 5 و 6 حجز متغيرات اثنين مصدر سجلات وواحد حقل الاسطر 7 و 8 اسناد متغيرين الى مصدرهما السطر التاسع البحث عن رقم الطالب 10 و 11 عمل حلقة لفحص الحقول في السجل المطلوب نقلة 12 و 13 و 14 اضهار رسالة باسم الحقل الفارغ وفتح النموذج على بيانات الطالب لاستكمال الحقول الفارغة وانهاء الاجراء لحين استكمال البيانات يمكن الاستغناء عن سطر 12 من 15 الى 21 في حالة عدم وجود حقول فارغة انقل السجل كل حقل بمكانه المحدد ايضا ممكن اختصاره من 7 اسطر الى 3 اسطر طالما اسماء الحقول متطابقة باقي الاسطر لانهاء الشرط والحلقة الدوارة واغلاق مصدر السجلات ملاحظة جعلنا مصدر النموذج الخاص بتنفيذ الامر جدول الطالب بدون اضافة اي حقول وممكن الاستغناء عن الخطوة بجعل الربط والغاء الربط عن كريق الكود ولكن الامر ليس مهما الملف مرفق تحياتي النهر.accdb

نعم ممكن عمل ذلك والفكرة تتلخص في عمل كود يبحث في البداية برقم الطالب الذي نرغب نقل بياناته هنا نستخدم مصدر السجلات Recordset ثم نعمل حلقة باستخدام For Each تمر على كافة حقول السجل المطلوب نقله ⬇️ For Each fld In rst.Fields If IsNull(fld.Value) Then اي في حالة وجود اي حقل فارغ نفذ الشرط وجواب الشرط يكون فتح نموذج الطالب وعلى نفس السجل الحالي لنقوم باستكمال الحقل او الحقول الفارغة DoCmd.OpenForm "frm_Stud", , , "[id]=" & [Text0] اي اننا نعمل نموذج يفتح عند تحقق وجود حقول فارغة واذا كان لديك مسبقا نموذج خاص بالطلاب فلادعي للنموذج الجديد اما في حالة عدم وجود حقول فارغة فيتم نقل السجل للجدول الاخر سواء عن طريق استعلام او عن طريق مصدر السجلات ونتوقف قليلا وندع الامر لاحد الاساتذة ربما لديه فكرة افضل تحياتي

01/ فتح نموذج في طريقة العرض : ' لفتح نموذج في طريقة العرض Private Sub Commande1_Click() DoCmd.OpenForm "fram2 ", acNormal End Sub ' acNormal هو اداة لعرض طريقة الفتح و هنا الفتح عادي 02/ فتح نموذج في طريقة التصميم : ' لفتح نموذج في طريقة التصميم Private Sub Commande1_Click() DoCmd.OpenForm "fram2 ", acDesign End Sub ' acDesign هو اداة لفتح النموذج في طريقة التصميم 03 لفتح النموذج في طرقة المعاينة للطباعة مثل التقرير : ' لفتح النموذج في طريقة المعاينة كالتقرير للطباعة Private Sub Commande13_Click() DoCmd.OpenForm "fram2", acPreview End Sub ' acPreview هذه الاداة هي المسؤولة على فتح النموذج في طريقة المعاينة كالتقرير 04 / لفتح النموذج في طريقة الشارت للرسوم البيانية : ' لفتح النموذج في طريقة الشارت لعرض الرسوم البيانية Private Sub Commande10_Click() DoCmd.OpenForm "fram2", acFormPivotChart End Sub 'acFormPivotChart هذه الاداة هي المسؤولة عن طريقة عرض النموذج كواجهة للرسوم البيانية

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا 💐 والشكر موصول لاخى واستاذى حسين @د.كاف يار جزاه الله خيرا 💐 اتفضل ان شاء الله يكون ما تريد Option Compare Database 'Option Explicit Private Sub btnSave_Click() DoCmd.GoToRecord , , acNewRec LastNum End Sub Private Sub Form_Load() LastNum End Sub Private Sub LastNum() lR = Nz(DLast("[رقم الوثيقة]", "[ضد الغير]"), 0) strRnum = Right(lR, Len(lR) - InStrRev(lR, "/")) + 1 strT = Left(lR, InStrRev(lR, "/")) Me.numW = strT & strRnum End Sub بالتوفيق k222 - 1.accdb

السلام عليكم ورحمة الله تعالى وبركاته اولا لم اجد استخدام الرموز الدولية الموحدة Unicode لا فى منتديات عربية ولا اجنبية ولا ادرى ان سبقنى اليها احد من قبل فى ستخدامها داخل الاكسس ولكنه توفيق من الله بالنسبة لى وسوف اشرح طريقة التوصل الى التعامل الصريح بـعلامة ( √ ) أو علامة ( x ) فى قواعد البيانات -------------- -------------- -------------- -------------- -------------- -------------- -------------- -------------- -------------- واخيـــــــــــــ( المرفق )ـــــــــــــــرا ( √ ) أو ( x )علامة.mdb

السلام عليكم بناء علي طلب احد الاخوه ولاهمية الموضوع و لسهولة الرجوع اليه تم عمله بموضوع جديد من محرر الاكواد و في محرر اكواد ThisWorkbook الصق الكود التالي و هو يقوم بعمل قائمة اسمها Adel بها بندين كل بند له ماكرو الند الاول aa و البند الثاني bb Private Sub Workbook_Open() Dim mnbNew As Menu Set mnbNew = MenuBars(xlWorksheet).Menus.Add("&Adel") mnbNew.MenuItems.Add "All&sheets", "aa" mnbNew.MenuItems.Add "Try Me", "bb" End Sub و قم بانشاء مديول جديد و الصق به الكود التالي Sub aa() On Error Resume Next Application.CommandBars("Workbook Tabs").Controls("More Sheets...").Execute If Err.Number > 0 Then Err.Clear Application.CommandBars("Workbook Tabs").ShowPopup End If On Error GoTo 0 End Sub Sub bb() On Error Resume Next ActiveSheet.Range("H5") = "Adel.Hanafy" Columns("H:H").ColumnWidth = 16.43 Range("H5").Select Selection.Font.Bold = True Selection.Font.Italic = True Selection.Font.Underline = xlUnderlineStyleSingle With Selection.Font .Name = "Arial" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleSingle .ColorIndex = xlAutomatic End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Font.ColorIndex = 5 End Sub خالص تحياتي اضافة قائمة في Menu bar.rar

السلام عليكم هذا اخي مثال مبسط جدا لما تريد الاستفسار عنه فالملف المرفق به كود عند الفتح يجعل قيمة الخليه A1=15 افتح الملف وغير في قيمة الخليه و قم بحفظ الشيت باي اسم اخر ثم اعد فتح الملف مرة اخري ستجد ان قيمة الخليه A1 قد عادت الي 15 وهذا كفكره مبسطه جدا لكود يطول شرحه بالنسبه لكل شيئ في الشيت الذي تتحدث عنه و الذي به اكواد تجعل اشياء كثيره تعود كما كان عليه الوضع قبل اجراء التعديل عليه حتي التنسيق للشيت يتم وضع كود له لارجاعه كما هو تحياتي bb.rar

(( ))