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

وعليكم السلام وبعد التحية والسلام على اخوي محمد سلامة وشفان تستطيع استعمال طريقتي في اي مكان كان ، وحتى في وحدة نمطية مستقله ، مثلا: public function Check_Records() dim rst as dao.recordset dim RC as integet set rst=currentdb.openrecordset("Select * From Table_Name") rst.movelast:rst.movefirst:RC=rst.recordcount if RC=>10000 then هنا تكتب ما تريد من الاوامر لوقف البرنامج endif end function . اما مثال اخوي شفان ، فيكون في النموذج فقط (هكذا بعد التعديل ، لكي تحصل على عدد السجلات الصحيح) Private Sub Form_Current() Me.RecordsetClone.movelast If Me.RecordsetClone.RecordCount >= 10 Then ' Me.Names.Enabled = False ' Me.ID.Enabled = False ' Me.PhoneNumber.Enabled = False Me.Form.AllowAdditions = False Else ' Me.Names.Enabled = true ' Me.ID.Enabled = true ' Me.PhoneNumber.Enabled = true Me.Form.AllowAdditions = True End If End Sub جعفر

حيا الله اخوي شفان الامر Recordset او Recordsetclone هما من عائلة DAO ، فإذا طلبت عدد السجلات مباشرة ، فستحصل على 0 (اي لا سجلات) ، او رقم (ولكن ليس عدد السجلات الصحيح) ، بينما اذا كان عندنا عدد كبير من السجلات ، فاكسس لا يجلب جميع هذه السجلات الى النموذج ، والامر RecordCount. كذلك لا يجلب عدد هذه السجلات ، والسبب ان اكسس يعرض لك عدد معين من السجلات بسرعة وبإستخدام ذاكرة اقل ، واذا اردت الحصول على عدد السجلات الصحيح ، فيجب ان تستخدم MoveLast قبل استعمال RecordCount جعفر

اتفضل اليك مثال على ذلك بطريقة اخرى Private Sub Form_Current() If Me.RecordsetClone.RecordCount >= 10 Then ' Me.Names.Enabled = False ' Me.ID.Enabled = False ' Me.PhoneNumber.Enabled = False Me.Form.AllowAdditions = False Else ' Me.Names.Enabled = true ' Me.ID.Enabled = true ' Me.PhoneNumber.Enabled = true Me.Form.AllowAdditions = True End If End Sub فقط استقبال 10 سجلات في النموذج.accdb

السلام عليكم ومشاركة مع استاذي جعفر يمكن وضعه في حدث الحالي.. او علي حسب طريقة عمل النموذج تحياتي

وعليكم السلام تستطيع حساب عدد السجلات هكذا (اكتب اسم الجدول بدلا عن Table_Name) : dim rst as dao.recordset dim RC as integet set rst=currentdb.openrecordset("Select * From Table_Name") rst.movelast:rst.movefirst:RC=rst.recordcount if RC=>10000 then هنا تكتب ما تريد من الاوامر لوقف البرنامج endif جعفر

السلام عليكم اخوي خلف رجاء توضيح اللي تريده من النموذج المرفق. جعفر

وعليكم السلام رجاء اخذ نسخة اضافية من بياناتك قبل العمل الطريقة التي عملتها هي: تغيير الارقام الى ارقام كبيرة غير موجوده في القائمة ، ثم تغيير الارقام الى التسلسل المطلوب تفضل . والكود خلف الزر: Private Sub cmd_Do_The_Changes_Click() 'make Reference to Microsoft DAO x.xx Object Library Dim rst As DAO.Recordset Dim biggest_Number As Long Dim i As Integer Dim j As Integer Dim RC As Integer Dim Multiply_by As String biggest_Number = Len(DMax("[ID]", "Data")) 'we have to do this in two steps: '1 based on the Biggest Number, lets multiply it by 10, so that No number id duplicated '2 then Seq based on the required Seq '1 Set rst = CurrentDb.OpenRecordset("Select * From Data") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC 'what number to multiply with Multiply_by = 1 For j = 1 To biggest_Number - Len(rst!ID) Multiply_by = Multiply_by & "0" Next j 'change the existing numbers to BIGGER NUMBERS rst.edit rst!ID = rst!ID * Val(Multiply_by) rst.Update rst.MoveNext Next i '2 rst.MoveFirst For i = 0 To RC - 1 'change the BIGGER NUMBERS to the new Seq rst.edit rst!ID = Me.int_Start + i rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing MsgBox "Done" End Sub . وبسبب وجود علاقة بين الجدولين Data و tell عن طريق الحقل ID ، فلما الكود يغير قيمة الحقل ID في الجدول Data ، فتلقائيا نجد ان القيمة قد تغيرت في الحقل ID في الجدول tell . جعفر 927.Access.accdb.zip

اتفضل ما طلبت اولا تم تغيير الكود للطباعة التقارير في النماذج الفرعية اولا غيرت نوعيته من Private الى Public و بعدين اضفت لهم جملة شرطية هكذا Public Sub Command21_Click() If Len(Me.Direct & vbNullString) <> 0 Then DoCmd.RunCommand acCmdSaveRecord stDocName = "St" DoCmd.OpenReport stDocName, acNormal End If End Sub وفي النموذج الرئيسي كتبت هذا الكود Private Sub PrintReports_Click() Call Form_stool.Command21_Click Call Form_Urine.Command33_Click Call Form_Chemistry_Tests.Command14_Click End Sub Print by one click.rar

احسنت اخي الكريم جعفر بارك الله فيك

السلام عليكم ورحمة الله العملية ممكن أن تتم و لكن على نموذج فردي و ليس مستمر كون حقل Rajmsanf2 حقل ليس له مرجع على الجدول لكن إذا مابنيت له حقل على الجدول سوف تخزن القيم بصورة صحيحة و بالتوفيق و إليك مثال القيمه بالحقلين نفس بعض.mdb

جاري التجربة اخي العزيز @jjafferr ما حكيت لي وين احط الكود ؟ قبل التحديث ولا بعد ........... الخ ؟؟

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

وعليكم السلام تفضل Private Sub Command9_Click() On Error GoTo err_Command9_Click If IsNull(Me.Text15) And IsNull(Me.TotalAmount) Then DoCmd.SetWarnings (False) DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70 DoCmd.SetWarnings (True) DoCmd.Close acForm, Me.Name Else DoCmd.Close acForm, Me.Name End If If IsNull(Me.Text15) Then DoCmd.SetWarnings (False) DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70 DoCmd.SetWarnings (True) DoCmd.Close acForm, Me.Name Else Dim Msg, style, title, result Msg = "هل تريد حفظ الفاتورة الحالية" style = vbYesNo title = " تنبيه" result = MsgBox(Msg, style, title) If result = vbYes Then [TotalAmount] = [Text17] [Descount] = [Text15] - [Text17] MsgBox "تم الحفظ سيتم الخروج", vbInformation, "تنبيه" DoCmd.Close acForm, Me.Name Else If result = vbNo Then DoCmd.SetWarnings (False) DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70 DoCmd.SetWarnings (True) MsgBox "تم حذف الفاتورة الحالية", vbInformation, "مع السلامة" DoCmd.Close acForm, Me.Name End If End If End If Exit_Command9_Click: Exit Sub err_Command9_Click: If Err.Number = 2467 Then Resume Exit_Command9_Click Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر

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

السلام عليكم عادةً ، لا نحفظ العمليات الحسابية في حقل في الجدول ، وانما هو سطر نضعه في الاستعلام او في النموذج/التقرير ، ونحصل على النتيجة ، صحيح ان الاكسس يحتوي على حقل محسوب ، ولكن المحترفين ينصحون بعدم استعماله ، لأن به مشاكل!! بغض النظر اينما اردت ان تضع الكود (قد تحتاج الى تغيير الفاصلة الى فاصلة منقطة): في الجدول ، في الحقل المحسوب iif([amount]<[cut],[amount],[amount]-[cut]) في الاستعلام amount_fin: iif([amount]<[cut],[amount],[amount]-[cut]) في النموذج/التقرير =iif([amount]<[cut],[amount],[amount]-[cut]) جعفر

السلام عليكم اخي ابو زاهر اعتذر منك ، ولكن كل محاولاتي باءت بالفشل جعفر

مرفق ملفان يحويان آخر الاكواد واحد للغة العربية ، و الاخر للانجليزية WordRemoveArabic.rar WordRemoveEnglish.rar قم بفك ضغط الملف ثم اسحبه الي داخل محرر الكود فى الملف الخاص بك ( يمكن الوصول اليه بضغط ALT+F11) او استيراده و اذا اردت أن تعمل الاكواد على كل الملفات فاضفه لمجلد normal كما فى الصورة ، او اضفها لملف معين اذا اردت ان تعمل على هذا الملف فقط او عندما يكون الملف مفتوحاً.

السلام عليكم من باب المشاركة فقط ردا علي أخونا khalid2117 السنة الكبيسة ليست بصفة عامة صحيح تقبل القسمة علي 4 لكن لها استثناء إن كانت تقبل القسمة علي 100 ، مثلا 2100 - 2200 - 2300 كلها سنوات بسيطة ، فبراير بها 28 يوم وليس 29 وهذا الاستثناء له استثناء وهي السنوات تقبل القسمة علي 400 فهي كبيسة أي أن فبراير بها 29 مثل 2400 - 2800 ويرجع هذا إلي أن السنة بالضبط لاتساوي 365.25 يوم كما هو شائع بل إنها 365.2422

الف الف شكر على المثال ان شاء الله اجد فرصه واشوفه

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

حسناً.. قمت بعمل نموذجين الأول لإنشاء الجدول.. مع إنشاء حقلين للبيانات الحقل الأول: بيانات رقمية صحيحة طويلة تعداد تلقائي الحقل الثاني: بيانات نصية بطول 20 حرف. الثاني لإضافة أو تعديل عنوان الحقل لجدول تم نأسيسه. مربعات التحرير والسرد لتسهيل الإجراء :: إليك المرفق:اشاء.accdb أهلا بك أستاذ عبدالله.. بما أنه يمكن إنشاء الجداول مع صيغة ACCDE فيمكن إنشاء وتعديل الجدول عن طريق الشفرة. يمكن ذلك عن طريق الاتصال بقاعدة البيانات المرتبطة عن طريق الشفرة بالصيغة التالية Option Compare Database Option Explicit Dim DB As DAO.Database Dim TDF As DAO.TableDef Set DB = OpenDatabase(REMOTE_DATABASE) Set TDF = DB.CreateTableDef(TABLE_NAME) '... AND SO ON........... تقبل الله منا ومنكم.. آمين

تفضل الملف يواسطة الاكواد (صفحة Salim) الكود Option Explicit Sub sum_by_Max() Dim My_Sh As Worksheet: Set My_Sh = Sheets("salim") Dim i%, m%: m = 1 Dim x# If ActiveSheet.Name <> My_Sh.Name Then Exit Sub Dim Arr1(), Arr2() Dim LastRow%: LastRow = My_Sh.Range("a1").CurrentRegion.Rows.Count Range("d2").Resize(LastRow, 2).ClearContents Range("g2").ClearContents For i = 2 To LastRow If Application.CountIf(Range("a" & 2, "a" & i), Range("a" & i)) = 1 Then ReDim Preserve Arr1(1 To m): Arr1(m) = Range("a" & i) m = m + 1 End If Next m = 1 For i = LBound(Arr1) To UBound(Arr1) x = Application.SumIf(Range("a2:a" & LastRow), Arr1(i), Range("b2:b" & LastRow)) ReDim Preserve Arr2(1 To m): Arr2(m) = x m = m + 1 Next With Range("d2") .Resize(UBound(Arr1)) = _ Application.Transpose(Arr1) .Offset(, 1).Resize(UBound(Arr2)) = _ Application.Transpose(Arr2) End With Range("d1:e" & UBound(Arr2) + 1).Sort _ key1:=Range("e2"), order1:=2, Header:=xlYes Range("g2") = UBound(Arr1) Erase Arr1: Erase Arr2 End Sub الملف مرفق(صفحة Salim) Salim.xlsm

تم اعادة رفع الملف sort_by_sum.xlsx

بعض الأكواد البسيطة والمطلوبة بعض الأكواد البسيطة التى يسأل عنها الأخوة الأعضاء ووجدتها في موقعنا الحبيب أوفسينا فجمعتها بعد إذن كاتبيها وتكون هذه دعوة لباقى الأخوة وعمالقتهم لتزويدنا بأكواد جديدة أو مشابهة .. والله الموفق 1- فتح الملف على اليوزرفورم Userform. يمكن فتح الملف على فورم بدلا من صفحة الإكسل المعروفة بكود بسيط تجده في كثير من ملفات الأخوة بالموقع وخطوات ذلك كالتالي: أ‌- أضف للملف يوزرفورم وذلك في محرر الفيجوال بيسك من قائمة إدراج(Insert) نختار (UserForm). ب- في قسم المشروع (Project) انقر مزدوجا ThisWorkbook ب‌- في نافذة الكود اكتب الكود التالي Private Sub Workbook_Open() UserForm1.Show End Sub وهذا الكود ليس به إلا سطر واحد يأمر الإكسل بفتح الملف على اليوزر فورم وهذا السطر هو UserForm1.Show بعد انتهاء العمل نجد أن الملف يفتح على الفورم ونجد ان الفورم يمكن تحريكه في أي اتجاه كما يمكننا أن نغلقه من مفتاح الغلق في أقصى يمين الفورم من أعلى كما نلاحظ أن ملف الإكسل يظهر وراء الفورم. أنظر First.rar 2- فتح الملف على اليوزرفورم مع إخفاء صفحة الإكسل. رأينا في المثال السابق ولإخفاء ملف الإكسل ضف السطر التالي للكود السابق ليصبح الكود بالصورة أن الملف يفتح على الفورم لكن ملف الإكسل يظهر وراء الفورم Private Sub Workbook_Open() Application.Visible = False UserForm1.Show End Sub هذا السطر Application.Visible = False يجعل ملف الإكسل مخفيا انظر المرفق Second.rar 3- فتح الفورم على مقاس الشاشة. والأن.. ماذا نفعل لنفتح الفورم على مقاس الشاشة؟ تابع معي: الفكرة أن نجعل أبعاد الفورم مثل أبعاد الشاشة ولكن باختلاف المستخدمين للملف سيكون هناك أبعاد مختلفة من حاسوب وآخر ولذلك يمكن عمل الكود التالي: ()Private Sub UserForm_Activate With Application Me.Top = .Top Me.Left = .Left Me.Height = .Height Me.Width = .Width End With ونجد أن الكود يطلب أن يكون اتساع الفورم كما اتساع التطبيق وارتفاع الفورم كإرتفاع التطبيق والآن جرب الكود في نافذة كود الفورم. انظر التطبيق Third.rar ولكن قم بتحريك الفورم في كل الاتجاهات، هل يستجيب الفورم للحركة؟ 4- نثبت الفورم (الفريم) بحيث لايمكن تحريكه الى اي اتجاه. يمكن نثبت الفورم بحيث لايمكن تحريكه الى اي اتجاه وذلك بكتابة هذا الكود في نافذة كود الفورم. Private Sub UserForm_Layout() With Me .Left = Application.Left .Top = Application.Top End With End Sub انظر التطبيق Forth.rar 5- الغاء رمز الاغلاق(x). يمكن إلغاء عمل رمز الأغلاق في أفصى يمين أعلى الفورم بالكود التالي ولكن هذا أن يجعلك تستطيع إغلاق الفورم أو الإكسل ولذلك أقترح أن تضع على الفورم مفتاح تسمية "إغلاق" ويكون له كود فقم أولا بكتابة الكودين المرفقين ()Private Sub CommandButton1_Click Unload Me End Sub )Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer If CloseMode = vbFormControlMenu Then Cancel = True End If End Sub لاحظ أن هذا الكود سيمنع إغلاف الفورم من (X) ولكن يمكن إغلاق الفورم من زر إغلاق الذي أضفناه، وإذا أردنا إغلاق الفور وملف الإكسل معا نضع السطر التالي في كود المفتاح بعد "Unload Me": ActiveWorkbook.Close True انظر التطبيق Fifth.rar 6- عمل شاشة افتتاحية. يحتاج بعض مطورى البرامج لأن يبدأ عمل ملفه بظهور شاشة أفتتاحية فعلى سبيل المثال "نريد عمل صفحه تبدأ مع فتح ملف الاكسيل، ويكون بها ايقونات بمسميات الشيتات الموجوده بالملف، وعند الضغط على احد الايقونات يتم النقل الى الشيت المطلوب بعض النظر عن الشيت الذي أقفل البرنامج عليه" فهيا معا نبنى هذا التطبيق: أ‌- افتح ملف جديد ثم ضف إليه في الصفحة الأولى شكلين أكتب على الأول كلمة "الورقة الثانية" وعلى الشكل الثاني كلمة "الورقة الثانية" ثم أربط كل شكل مع ورقة العمل المناسبة لما كتب عليع وذلك ربطا تشعبيا" ب‌- كرر العمل في الورقة الثانية والثالثة مع تغيير ما يلزم. ت‌- أضف فورم للملف وضع عليه ثلاثة مفاتيح أكتب على الأول "الورقة الأولى" والثاني "الورقة الثانية" والثالث "الورقة الثالثة" ث‌- أكتب الكود التالي في مكان كود الفورم ()Private Sub CommandButton1_Click Unload Me Worksheets("Sheet1").Activate End Sub ()Private Sub CommandButton2_Click Unload Me Worksheets("Sheet2").Activate End Sub ()Private Sub CommandButton3_Click Unload Me Worksheets("Sheet3").Activate End Sub ج‌- اكتب الكود التالي في مكان كود "ThisWorkbook": ()Private Sub WorkBook_Open UserForm1.Show End Sub انظر التطبيق "شاشة أفتتاحية.rar" إخواني الأعزاء أسمحوا لي أن أتوقف هنا وإذا كنتم أستفدتم فسأكمل. والله الموفق ربنا يبارك فيك بحق الله اخي رؤوف1951 =============================================== بعض الأكواد البسيطة.rar =========================== سر على بركة الله واكمل