أبو آدم

أخي العزيز

يرجى الإلتزام بعدم تشعيب مشاركات الموضوع الواحد بعيدا عن السؤال الرئيسي

المرفق يجيب عن سؤالك الخاص بفرز السنة و الشهر و اليوم كل في عامود مستقل عند احتساب العمر

مع رجاء افراد موضوع جديد لموضوع خطأ القيمة الفارغة حال حاجتك اليه.

تفضل المرفق ......

..............
NA_CalcAge - Split.rar

إخوتي الأعزاء

هذا ايضا متاح

قم بفتح وحدة نمطية جديدة وأدرج بها :



Option Explicit Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function وفي حدث عند التحميل للنموذج أدرج الكود التالي: Private Sub Form_Open(Cancel As Integer) Dim x As String x = "123" Dim y As String y = InputBoxDK("Enter Password for form") If x <> y Then MsgBox ("Invalid password") DoCmd.CancelEvent End If End Sub

وننال المراد بإذن الله
وللتطبيق اليك المرفق (كلمة المرور 123)

والله من وراء القصد ....
.....
NA_PasswordMaskedInputbox.rar

أخي العزيز
كل شيئ متاح بإذن الله

تفضل ....
NA_ReportSortingUp.rar

أخي فرهاد
في التقرير وفي خياراته غير حدث منبثق Pop Up الى نعم



....

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


Private Sub strName_AfterUpdate() Dim rs As ADODB.Recordset, MyVal As Date Dim x As Date Set rs = New ADODB.Recordset 'Open a Connection to the Recordset rs.Open "SELECT MAX(strDate) from Table1", CurrentProject.Connection rs.MoveFirst MyVal = (rs.Fields(0).Value) + 1 x = Format(MyVal, "yyyy/mm/dd") rs.Close Set rs = Nothing Me.strName.SetFocus Me.strDate = x End Sub

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

والله من وراء القصد ...
NA_MaxDate_UP.rar

أخي العزيز

في حدث بعد التحديث للحقل المعني أضف الكود التالي


Private Sub nob_d_AfterUpdate() Dim rst As Recordset Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF If rst![nob d] = Me![nob d] Then MsgBox " السجل مكرر ، رقم المصنف مسجل سابقا ", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do End If rst.MoveNext Loop rst.Close End Sub

والله الموفق ... وهو المستعان

أخي العزيز

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

ونحن في العون ما قدر لنا
Na_db2.rar

أخي العزيز

تفضل
NA_Retired.rar

تفضل
NA_Sample.rar

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

جرب ووافني بالنتيجة

والله من وراء القصد
NA_Counter_Readings.rar

أخي العزيز
تفضل

في خيارات النموذج عدل ما يلي:


أنشئ ماكرو جديد > في action ثبت Maximize


في خيارات النموذج وفي حدث On Load تثبت استخدام الماكرو كما يلي:


في خيارات النموذج وفي Shortcut Menu عدل كما يلي لإيقاف استخدام الزر الايمن للماوس والدخول لوضع التصميم للنموذج (مثلا) ، ما لم يؤثر ذلك على استخدامل لقوائم أخرى:


وتفضل التطبيق
NA_Full.rar

أخي العزيز

المرفق جهد طيب لأحد الاخوة جزاه الله خيرا ، وجدته في مكتبتي ، وللامانة لا أذكر ان كنت قد أجريت عليه أي تعديلات أم لا !!

الله المستعان فاستعن به

ونحن في العون ما استطعنا

OUT_IN.rar

الموضوع هام ... لا مانع كون المثال جاهز لدي من مكتبتي

مع رجاء ان تتذكرونا بصالح الدعاء

مع كل احترامي وتقديري لأستاذتي زهرة العبدالله

والله من وراء القصد
N_test_Calendar.rar

اخي العزيز

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


Nationality090209.rar