ابوخليل

تفضل الحل حسب ما فهمت
FSaturday.rar

وعليكم السلام ورحمة الله وبركاته
 
عدد النماذج المفتوحة :
CountOpenFrms = Application.Forms.Count السؤال الثاني افتح له مشاركة جديدة

انا قمت بالتعديل فقط على عجالة لتحقيق الطلب
 
اليك الكود الآن بعد التدقيق ( تم اجراء بعض التقديم والتأخير وحذف مالا يلزم )
 
 
Dim rcos, r As Long Private Sub Command1_Click() On Error GoTo Err r = rcos + 20 txtNumbers = "" Dim s For s = rcos To r txtNumbers = txtNumbers & "973" & txtnum & " , " DoCmd.GoToRecord , , acNext rcos = rcos + 1 If rcos = r Then Exit Sub End If Next s Err:         If Err.Number = 2499 Then Exit Sub End Sub Private Sub Form_Load() rcos = 1 End Sub

If KeyCode = 13 Then DoCmd.GoToRecord , , acNewRec End If تم تطبيق الكود على الحقل n
 
يمكنك نقله الى اي حقل تريد
 
1.rar

تفضل
الدالات الخاصة ببرنامج الآكسس.rar

وعليكم السلام
تفضل :
Private Sub Form_Open(Cancel As Integer) DoCmd.Maximize End Sub  
ملحوظة : اخي الكريم  في المرات القادمة احرص على اختيار عنوان مناسب يصف الموضوع
تم تعديل العنوان

وعليكم السلام
 
هذا السطر  يجعل المستند يغلق بدون المطالبة بالحفظ
Private Sub document_close() ActiveDocument.Saved = True End Sub ولكن لن يتم حفظ آخر حركة
 
ولحفظ آخر حركة ثم الخروج بدون مطالبة نضيف اليه سطرا  :
Private Sub document_close() ActiveDocument.Save ActiveDocument.Saved = True End Sub ملحوظات : لكي يعمل الكود يجب تخفيظ امان الماكرو الى الحد الادنى 
 مكان الكود : اضغط Alt + f11  
حدث الكود : عند اغلاق المستند
 
وإليك الأمثلة
Doc7.rar
Doc8.rar

وعليكم السلام
جرب هذا :
000.000.00.00;0;

تفضل من هنا  آمل ان يفي بحاجتكhttp://www.officena.net/ib/index.php?showtopic=52980&page=2#entry333142 

قد ذكرت لك ذلك رعاك الله
 
ولديك حقلان آخران ايضا هما المنصب والخطورة
ولا بأس في ظهور الحقول الاربعة في استعلام الراتب  لاننا لن نستخدمهما . ولن تجري عليهما عمليات مستقبلا
تم التعديل على المثال ويمكنك ملاحظة الحقول الجديدة المعدلة داخل استعلام الالحاق ( فقط زيادة حرف X )
dd11.rar

تم التعديل بحيث عن طريق نموذج 2  يفتح نموذج1 على السجل المحدد فقط
ج.rar

تفضل اخي الكريم
هذا مثال يشتمل على الكود الذي طلبته وقد تم ضبطه على ثلاث سجلات
ويمكنك تغيير الرقم داخل الكود كما تشاء
 
Example1.rar

جرب : احذف الجداول المرتبطة  ثم اعمل لها ربط من جديد
لسان التبويب جداول / جديد/ ربط
واذا لم تصل الى حل فلا بأس ان تعيد تنصيب اوفيس

تفضل
Q2.rar

التطبيق على ثلاث حقول فقط :
لتحقيق مطلوبك هناك عدة ضوابط
الاول : لابد ان تكون قيمة الحقول هي القيمة الرقمية للالوان
وهذه يسيرة فيمكن ان يظهر اسم اللون مع بقاء القيمة رقمية ( انظر حقلي 4 ، 5 في الجدول )
كما يمكننا الاستغناء عن مربع التحرير في الجدول  ونجعله يظهر رقما كما هو ويكون اظهار الاسماء داخل التقرير او النموذج حسب الحاجة
الثاني : وضعت لك في الحقول الثلاث الاولى القيمة الافتراضية = صفر  لهذا ستظهر الحقول التي لم تأخذ رقما سوداء
 
انظر التعديل ووافني بالنتيجة
VGA Color Cable3.rar

ولا يهمك  انظر التعديل ووافني بالنتيجة
 
احصاء اسبوعي4.rar

بعد هذه المشاركة آمل ان تفتح موضوعا جديدا
 
1- لفتح نموذج التعديلات على اسم الموظف :  افتح نموذج بيانات الموظفين وانقر نقرا مزدزجا على رقم الموظف
2- التعديلات على الراتب او الاولاد وغيرها ..... يتم التعديل ويوضح بالملاحظات تاريخ وامر التعديل
3- الفروقات يتم اعداد مسيرات افرادية لها
4- اكسس لا يحتاج الى زر حفظ فهو يحفظ آليا
 
وبالتوفيق ،،،
رواتب9.rar

الشكر مقدما لأخي ابي آدم على التنسيق
 
اخي الكريم 
جرب استبدال هذا السطر :
iNext = Val(Mid(vLastY, 9, 4)) + 1 بهذا :
iNext = Val(Mid(vLastY, 6, 5)) + 1

برنامج يقوم بتحويل عبارات SQL الى كود
تفتح الاستعلام على التصميم وعلى عبارة sql ثم تنسخها وتلصقها في البرنامج المرفق
وهو سيقوم بالمهمة وينسخ في الذاكرة الكود المحول .
كل ما عليك فعله بعد اللصق داخل الحدث  هو ان تستبدل كلمة  strsql =   مع علامة يساوي تستبدلها بــ :  Docmd.RunSQL
ولا تنسى ان تجعل الكود بين علامتي تنصيص مزدوجتين
تحويل SQL إلى VBA.rar

لا يزيد عن عشرة ؟  لانه ما زال حقلا نصيا  وفي الحقل النصي التسعة اكبر من العشرة بل الاثنان اكبر من العشرة
لذا فالكود يختار اكبر عدد في الحقل النصي وهو التسعة ثم يقوم بتحويله الى رقم  ثم يضيف اليه واحد  ليصبح عشرة
ولكن رقم عشرة موجود فعلا  لذا يرفض اكسس تكرار الرقم .
ومن هنا يتبين  من اين جاءت المشكلة التي تحدث معك .
 
والحل هو ان نقوم بتحويل العدد المقتطع  الى رقم قبل اختيار اكبر عدد وهذا ماتم تحقبقه في التعديل أدناه
التعديل تم داخل سطرين فقط وقد بينتهما .
  Private Sub ts1_AfterUpdate()     Dim db As Database     Dim rs As Recordset     Dim strSQL As String     Dim i As Long  ' (1)هذا السطر     Set db = CurrentDb     strSQL = "SELECT Max(CLng(Right([no1],Len([no1])-1))) AS xc FROM tb WHERE (((tb.chk)=paray()))" '(2) وهذا السطر     Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)     If rs.RecordCount > 0 Then     rs.MoveFirst     On Error Resume Next     i = rs![xc]     If ts1 = 1 Then     Me.no1 = "A" & i + 1     ElseIf ts1 = 2 Then     Me.no1 = "B" & i + 1     ElseIf ts1 = 3 Then     Me.no1 = "C" & i + 1     End If     End If     rs.Close     Set rs = Nothing     Set db = Nothing     Me.chk = Me.ts1     End Sub

وهذا حل  بدالة أخرى
 
Private Sub No_AfterUpdate() Dim x As Integer x = No For x = x To 20 No = x DoCmd.GoToRecord , , acNext No = No + 1 Next End Sub

هذه سياسة أكسس ، حيث ان الحركة هذه مقصودة ، فقد تكون مفيدة أمنياً
وقد رأيت محاولات ناجحة لاستخدام هذه الارقام مرة اخرى بعد حذفها
وعلى كل حال هناك عدة طرق يمكن من خلالها عمل ترقيم تلقائي مصنوع مثل هذه العبارة البرمجية :
Me.ID=Dmax("ID","table")+1 وفي هذه الطريقة يمكنك استخدام الرقم المحذوف بكتابته يدويا

تم التعديل
واليك بعض التوجيهات العامة
1- ينصح دوما بوضع مفاتيح للجداول  او معرفات وحيدة غير قابلة للتكرار او كليهما
2- الافضل ان تكون اسماء الكائنات والعناصر بحروف انجليزية  لما يترتب على ذلك من الفائدة عند كتابة العبارات والجمل البرمجية
3- تجنب وضع مسافات خالية بين الاسماء ويمكنك التعويض عن ذلك بوضع علامة تحت السطر بين الكلمتين 
test.rar

افكارك جميلة  وقد استفدت من هذه الفكرة  وادرجتها  ضمن برنامج اقوم حاليا بالتعديل عليه
 
تم عمل المطلوب بالاستعانة بخانة الاختيار الموجودة في الجدول
 
ملحوظة : قمت بالتعديل على بعض المسميات  مثل Name  و Date  لان هذه المسميات محجوزة في اكسس 
وللطلاع اكثر انظر هنا https://www.google.com/url?q=http://www.officena.net/ib/%3Fshowtopic%3D39164&sa=U&ei=FndvUp_GAdOe7AbyhIHIBw&ved=0CAcQFjAA&client=internal-uds-cse&usg=AFQjCNEfZVlBCmixMQd_sPfjf4BDxj05dw
تعديل 3 على الكود.rar

الصق هذا الكود داخل محرر النموذج الفرعي
Private Sub subaccount_AfterUpdate() Combo35 = subaccount.Column(2) End Sub  
_MSH-ACC.rar