كل الانشطه

المهم انت عندك .. ده كفاية وانت من جواك عارف ومتيقن انى لو عاوز اعمل زيها بفضل هقدر 😉 ... برضو ده كفاية 😛

عندك زيها 😉 😛

انت بتفكرني بـ " أذاكر وأنجح " 😂 انت لو قرأت الموضوع كويس كان عرفت انه الملف اللي انت محتاجه موجود في أول مشاركة 😉

الكود الافضل فى الوحدة النمطية تتم كتابته بالشكل التالى Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" _ (ByVal hHook As LongPtr, ByVal nCode As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" _ (ByVal lpModuleName As String) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As LongPtr, _ ByVal hMod As LongPtr, ByVal dwThreadId As Long) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As LongPtr) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hWnd As LongPtr, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function EnumChildWindows Lib "user32" _ (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _ ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As LongPtr, ByVal wMsg As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long Private m_hHook As LongPtr #Else Private Declare Function CallNextHookEx Lib "user32" _ (ByVal hHook As Long, ByVal nCode As Long, _ ByVal wParam As Long, ByVal lParam As Long) 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 GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hWnd As Long, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32" _ (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private m_hHook As Long #End If Private Const WH_CBT As Long = 5 Private Const HCBT_ACTIVATE As Long = 5 Private Const HC_ACTION As Long = 0 Private Const EM_SETPASSWORDCHAR As Long = &HCC Private Const EM_GETPASSWORDCHAR As Long = &HD2 Private Const PASSWORD_CHAR As Long = 42 Private Const DIALOG_CLASS As String = "#32770" Private Const EDIT_CLASS As String = "Edit" #If VBA7 Then Public Function EnumChildProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long Dim sClass As String Dim nChars As Long Dim verifyChar As LongPtr #Else Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim sClass As String Dim nChars As Long Dim verifyChar As Long #End If sClass = String$(256, vbNullChar) nChars = GetClassName(hWnd, sClass, 255) If nChars <= 0 Then EnumChildProc = 1 Exit Function End If If Left$(sClass, nChars) <> EDIT_CLASS Then EnumChildProc = 1 Exit Function End If SendMessage hWnd, EM_SETPASSWORDCHAR, PASSWORD_CHAR, 0 verifyChar = SendMessage(hWnd, EM_GETPASSWORDCHAR, 0, 0) If verifyChar = PASSWORD_CHAR Then EnumChildProc = 0 Else EnumChildProc = 1 End If End Function #If VBA7 Then Public Function HookCallback(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr #Else Public Function HookCallback(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long #End If Dim sClassName As String Dim nChars As Long If nCode < HC_ACTION Then HookCallback = CallNextHookEx(m_hHook, nCode, wParam, lParam) Exit Function End If If nCode = HCBT_ACTIVATE Then sClassName = String$(256, vbNullChar) nChars = GetClassName(wParam, sClassName, 255) If nChars > 0 Then If Left$(sClassName, nChars) = DIALOG_CLASS Then EnumChildWindows wParam, AddressOf EnumChildProc, 0 End If End If End If HookCallback = CallNextHookEx(m_hHook, nCode, wParam, lParam) End Function Public Function SecureInputBox( _ ByVal Prompt As String, _ Optional ByVal Title As String = "", _ Optional ByRef WasCancelled As Boolean = False, _ Optional ByVal XPos As Long = -1, _ Optional ByVal YPos As Long = -1) As String Dim sResult As String Dim threadID As Long #If VBA7 Then Dim hMod As LongPtr #Else Dim hMod As Long #End If If Len(Trim$(Prompt)) = 0 Then err.Raise vbObjectError + 1001, "SecureInputBox", "Prompt cannot be empty." End If On Error GoTo SafeExit threadID = GetCurrentThreadId() hMod = GetModuleHandle(vbNullString) m_hHook = SetWindowsHookEx(WH_CBT, AddressOf HookCallback, hMod, threadID) If m_hHook = 0 Then err.Raise vbObjectError + 1002, "SecureInputBox", "Failed to install Windows hook." End If If XPos >= 0 And YPos >= 0 Then sResult = InputBox(Prompt, Title, "", XPos, YPos) Else sResult = InputBox(Prompt, Title, "") End If WasCancelled = (StrPtr(sResult) = 0) SecureInputBox = sResult SafeExit: If m_hHook <> 0 Then UnhookWindowsHookEx m_hHook m_hHook = 0 End If If err.Number <> 0 Then Dim errNum As Long, errDesc As String errNum = err.Number errDesc = err.Description err.Clear err.Raise errNum, "SecureInputBox", errDesc End If End Function Public Sub ZeroString(ByRef sValue As String) If Len(sValue) > 0 Then sValue = String$(Len(sValue), vbNullChar) End If End Sub فى زر الامر يتم الاستدعاء بالشكل التالى Dim strPWord As String Dim strTitle As String Dim isCancel As Boolean strTitle = "سبحان الله وبحمده سبحان الله العظيم" strPrompt = "كلمة المرور مطلوبة للمتابعة." strPWord = SecureInputBox(strPrompt, strTitle, isCancel) If isCancel Then Exit Sub If strPWord = "1001" Then DoCmd.OpenForm "frmPassStars", acNormal Else MsgBox "الرقم السري الذي أدخلته غير صحيح - من فضلك أدخل الرمز الصحيح", vbExclamation, str_Title End If ZeroString strPWord

خلينا نرد الرقم &H1324 مش ثابت بيشتغل في أغلب الحالات لكن ممكن يفشل حسب إصدار الاوفيس او الويندوز دا غير ان لو حصل Error قبل : UnhookWindowsHookEx hHook الهـوك هيفضل شغال فى زر الامر تم استخدام : Cancel = True Cancel بيستخدم فقط في Events فيها معامل : Cancel مثلا زى : Form_BeforeUpdate(Cancel As Integer) يعنى من الاخر السطر ده : Cancel = True مالوش أي تأثير والمفروض ينحذف كمان استخدام : DoCmd.SetWarnings False مالوش أى لزوم هنا لانه بيستخدم مع الاستعلامات لمنع الرسائل الافتراضية فقط والرد الشافى فى النقطة دى المعامل الثالث (Default) هو النص الافتراضي داخل مربع الإدخال فيه احتمالين للمشكلة مع 32 بت الاول : الهوك بيشتغل لحظة إنشاء النافذة وجود نص افتراضي (Default) يخلي الكنترول يتعمل له تهيئة بطريقة مختلفة النتيجة: الـ Password masking (*) ما يتطبقش أو يحصل خلل الثانى : اختلاف داخلي في الـ : InputBox (32 بت مقابل 64 بت) الـ Edit control ID (&H1324) بيتأثر بوجود Default Text مع النواة 32 او مع احد الاصدارات والنتيجة : EM_SETPASSWORDCHAR ممكن تروح لعنصر غلط أو تفشل طيب السؤال الان هل الحل ده صح و جذرى: InputBoxDK("Password required to proceed.", str_Title) من حيث الصحة : جزئيا صح ولكن مش جذرى ومش احترافى ومش الأصح طيب إيه الحل الصح : strAdminPWord = InputBoxDK("Password required to proceed.", str_Title, "") وبعد ان قمنا بالتفنيد والرد المناسب واللى ماله علاقة اساسا بالمشكلة مناط السؤال المشكلة الحقيقية تكمن فى خلل بقاعدة البيانات المرفقه نفسها لو عملت قاعدة جديدة وقمت باستيراد العناصر ( النماذج والوحدة النمطية العامة ) تقريبا سوف تنحل مشكلتك والسبب فى الصورة التالية من قاعدتك أكود لعناصر شبحية تم حذفها ولكن مازالت عالقة بالقاعدة

اه هو فعلا خبرة مفيش كلام وكلنا وانا تتمنى نستفيد من الخبرة دى

حلوة الافكار مفيش كلام بس معلش الانترنت بعافية كان نفسي والله بس يا خسارة وبرضو حلوة الثقة مفيش كلام

وحقا عمل جميل ورائع ونتمنى نتمنى منك عندما ينتهي البرنامج ياريت ترفعه مفتوح المصدر لكي نستفيد من خبراتك

وانا اتمنى كذلك و مشتاق لارى الاضافات الجميلة والافكار

تفضل استاذ @بلال بلال وانا اسف على المشاكة السابقة لأني كنت فاهم الموضوع غير المهم تفضل الشرح والمرفق وانت عندك الباسوورد . ووافني بالرد . Yamen-QRCode_WithTrialPeriod.rar

فى انتظار نهاية المدة بلهفة واشتياق علشان نشوف الافكار النيرة ......... علشان نتعلم ونثقل خبرتنا

الأســـــــــد يزأر في المدى سلطانَه ...... والكــلب إن عوى فلا يسمع له خطابُ ها هي الأســــود وإن أُهينت زئيرها ...... يبقى يسيـــرُ بهيبتهِ ويُهـــــــــــــــــابُ تبقى الكـــــــــلاب وإن تعالت لحظةً ...... ‏في أرضها محصورة، يحكمها الخـــرابُ تمضي الأسودُ في عـزٍّ وفي شَـمَـمٍ ...... وتبقى الكــــــلابُ تنبـحُ فـي السِّـرابِ ستشرقُ شمـسُ الحـقِّ بعد غيابها ...... ويصمتُ حينها نباحُ الكــــــــــــــــــــلابِ

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

مشاركة مع استاذي @Eng.Qassim تفضل استاذ @بلال بلال الشرح والمرفق . مع الاخذ بااعتبار يومي الجمعة والسبت والاجازات العامة لم تحسب . ووافني بالرد . Yamen-Trial Period.rar

ههههههههههههه يخلق من الشبه 40 مش عارف شوفت بعض الافكار فين بس برافو تطبيق رائع

فكرة رائعة

يمكن وضعه كنموذج فرعى داخل اى نموذج وسوف يعمل على الفور بدون ادنى تدخل الاكواد التى تمت كتابتها لهذا العمل Option Compare Database Option Explicit Private mHostForm As Access.Form Private mRecordCount As Long Private mIsInitialized As Boolean Private mLastPosition As Long Private mLastCount As Long Private mLastIsNew As Boolean Private mHasLastState As Boolean Private Sub Form_Load() InitializeNavigator End Sub Private Sub InitializeNavigator() If Not EnsureHostForm Then Exit Sub RefreshRecordCount True With mHostForm.Recordset If Not (.BOF And .EOF) Then .MoveFirst End With UpdateUI mIsInitialized = True End Sub Private Sub Form_Current() If mIsInitialized Then UpdateUI End Sub Private Function EnsureHostForm() As Boolean On Error GoTo ErrorHandler If mHostForm Is Nothing Then If TypeOf Me.Parent Is Form Then Set mHostForm = Me.Parent End If ExitFunction: EnsureHostForm = Not (mHostForm Is Nothing) Exit Function ErrorHandler: Set mHostForm = Nothing Resume ExitFunction End Function Private Function HasRecords() As Boolean HasRecords = (mRecordCount > 0) End Function Private Sub RefreshRecordCount(Optional ByVal force As Boolean = False) On Error GoTo ErrorHandler If Not EnsureHostForm Then mRecordCount = 0 Exit Sub End If If Not force Then If mRecordCount > 0 Then Exit Sub End If With mHostForm.RecordsetClone If .BOF And .EOF Then mRecordCount = 0 Else .MoveLast mRecordCount = .recordCount End If End With ErrorHandler: End Sub Private Function GetCurrentPosition() As Long On Error GoTo ErrorHandler If Not EnsureHostForm Then GetCurrentPosition = 0 ElseIf mRecordCount <= 0 Then GetCurrentPosition = 0 ElseIf mHostForm.NewRecord Then GetCurrentPosition = mRecordCount + 1 Else Dim pos As Long pos = mHostForm.CurrentRecord If pos <= 0 Then pos = 1 GetCurrentPosition = pos End If Exit Function ErrorHandler: GetCurrentPosition = 0 End Function Private Sub UpdateUI() On Error GoTo SafeExit Dim frm As Form Dim currentPosition As Long Dim isEmpty As Boolean Dim isNew As Boolean Dim isFirst As Boolean Dim isLast As Boolean If Not EnsureHostForm Then If Not mHasLastState _ Or mLastPosition <> 0 _ Or mLastCount <> 0 _ Or mLastIsNew <> False Then Me.lblRecordPosition.Caption = "0 of 0" Me.cmdGoFirst.Enabled = False Me.cmdGoPrevious.Enabled = False Me.cmdGoNext.Enabled = False Me.cmdGoLast.Enabled = False Me.cmdDeleteCurrent.Enabled = False mLastPosition = 0 mLastCount = 0 mLastIsNew = False mHasLastState = True End If Exit Sub End If Set frm = mHostForm currentPosition = GetCurrentPosition() isEmpty = (mRecordCount <= 0) isNew = frm.NewRecord If mHasLastState Then If mLastPosition = currentPosition _ And mLastCount = mRecordCount _ And mLastIsNew = isNew Then Exit Sub End If If isEmpty Then Me.lblRecordPosition.Caption = "0 of 0" Else Me.lblRecordPosition.Caption = currentPosition & " of " & mRecordCount End If isFirst = (currentPosition <= 1 And Not isNew) isLast = (currentPosition >= mRecordCount And Not isNew) Me.cmdGoFirst.Enabled = Not isEmpty And Not isFirst Me.cmdGoPrevious.Enabled = Not isEmpty And Not isFirst Me.cmdGoNext.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdGoLast.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdDeleteCurrent.Enabled = Not isEmpty And Not isNew mLastPosition = currentPosition mLastCount = mRecordCount mLastIsNew = isNew mHasLastState = True Exit Sub SafeExit: Debug.Print "UpdateUI Error: "; Err.Number; " - "; Err.Description End Sub Private Sub cmdGoFirst_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveFirst mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoPrevious_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then cmdGoLast_Click Exit Sub End If On Error GoTo ErrorHandler With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark If mHostForm.CurrentRecord > 1 Then .MovePrevious mHostForm.Bookmark = .Bookmark End If End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoNext_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub On Error GoTo ErrorHandler If mHostForm.CurrentRecord >= mRecordCount Then UpdateUI Exit Sub End If With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark .MoveNext If Not .EOF Then mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoLast_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveLast mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdCreateNew_Click() On Error GoTo ErrorHandler If Not EnsureHostForm Then Exit Sub mHostForm.SetFocus DoCmd.GoToRecord acDataForm, mHostForm.name, acNewRec RefreshRecordCount True UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdDeleteCurrent_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub If MsgBox("هل تريد حذف السجل الحالي نهائيًا؟", vbYesNo + vbQuestion + vbDefaultButton2, "تأكيد الحذف") <> vbYes Then Exit Sub On Error GoTo ErrorHandler Dim rsClone As DAO.Recordset Dim bm As Variant Dim nextBM As Variant Set rsClone = mHostForm.RecordsetClone bm = mHostForm.Bookmark rsClone.Bookmark = bm rsClone.MoveNext If rsClone.EOF Then rsClone.Bookmark = bm rsClone.MovePrevious If rsClone.BOF Then nextBM = Null Else nextBM = rsClone.Bookmark End If Else nextBM = rsClone.Bookmark End If If mHostForm.Dirty Then mHostForm.Dirty = False End If mHostForm.Recordset.Delete RefreshRecordCount True If IsNull(nextBM) Then mHostForm.SetFocus DoCmd.GoToRecord , , acNewRec Else mHostForm.Bookmark = nextBM End If rsClone.Close Set rsClone = Nothing UpdateUI Exit Sub ErrorHandler: On Error Resume Next If Not rsClone Is Nothing Then rsClone.Close Set rsClone = Nothing End If HandleNavigatorError Err.Number, Err.Description End Sub Private Sub HandleNavigatorError(ByVal errorNumber As Long, ByVal errorDescription As String) Select Case errorNumber Case 0, 3021 Exit Sub Case Else MsgBox "حدث خطأ رقم " & errorNumber & vbCrLf & errorDescription, vbExclamation, "خطأ في أداة التنقل" End Select End Sub Navigator.accdb

رائع

وعليكم السلام اليك هذه المحاولة trial.rar

اعرض الملف لعشاق كرة القدم (ملف أكسل لإحتساب نتائج كأس العالم 2026) رغم أني لا أنشط إلا في منتدى أكسس إلا أني اليوم قررت أن أرفق لكم ملف أكسل جميل كان قد أرسله لي شقيقي الأصغر هشام بعد أن وجده في أحد المواقع الأجنبيه وقام بتعريبه ووضع بعض التحسينات عليه وقد إستأذنته في رفعه إلى المنتدى ووافق بكل سرور كل ما عليكم هو إدخال النتائج في الورقة Match Results وسيقوم أكسل ببقية العمل أرجو أن ينال العمل إستحسانكم وإذا كان هناك أي ملاحظات فلا تتردوا في ذكرها تحياتي صاحب الملف منتصر الانسي تمت الاضافه 04/11/26 الاقسام قسم الإكسيل

اعرض الملف أداة إنشاء المخططات البيانية المخصصة {سلسلة الأدوات المساعدة المخصصة} اقدم لكم اليوم هذه الأداة البسيطة في تصميمها والرائعة في نتائجها في القيام بتمثيل البيانات بمخططات بيانية لإنشاء تقارير رسومية الحقيقة أن هذه الأداة ليست بكفاءة عنصر التحكم Chart ولكنها تؤدي أغلب النتائج المطلوبة في المخططات البيانية البسيطة التي على شكل أعمدة أو خطوط ولا تتطلب أي مهارات للعمل بها قمت بإرفاق ملف أكسس يحتوي على كل ما ستحتاجونه لفهم الأداة وطريقة إستخدامها والإستفادة منها في تطبيقاتكم أرجو أن تنال إستحسانكم وفي إنتظار أي ملاحظات أو أخطاء قد يجدها البعض تحياتي صاحب الملف منتصر الانسي تمت الاضافه 04/11/26 الاقسام قسم الأكسيس  

استاذ السلام عليكم اريد برنامج الفترة التجريبة يحتوي على: تاريخ بدء الفترة التجريبة - تاريخ نهاية الفترة التجربية - عدد والأيام الفترة التجربية اريد عند فتح البرنامج تظهر له رسالة تنبيه بانتهاء الفترة

بارك الله فيك تمام هو المطلوب بالضبط ... استاذنا Foksh

أخواني وأساتذتي ومعلمينا ( دون استثناء ) يتوفر نظام متكامل للتفعيل من خلال الإنترنت بالمميزات التالية :- نظام بصمة لكل جهاز فريد وغير متكرر . التفعيل من خلال البريد الإلكتروني + بصمة الجهاز . سيرفر يسجل جميع النسخ التي تم تشغيلها لبرنامجك . رمز Pin لتأكيد التفعيل بالبريد الإلكتروني بمدة محددة = 5 دقائق ، عند التفعيل لأول مرة فقط . إمكانية استرجاع التفعيل لنسخة العميل حتى بعد الفرومات وتغيير الجهاز . دعم متكامل للشركات التي تستخدم برنامجك على أكثر من جهاز . فيمكن استعمال رمز التفعيل على عدد تقرره وتحدده انت يصل لـ 100 جهاز على سبيل المثال ليقوم بالتفعيل من خلال رمز تفعيل واحد . دعم التفعيل المرن بمدة حسب الحاجة ( شهر ، 3 شهور ، 6 شهور ، سنة ، مدى الحياة ، مدة محددة على سبيل المثال 40 يوماً ) . دعم إمكانية حجب نسخة عميل من التفعيل واستخدام البرنامج . دعم الإقفال عند التلاعب بالوقت والتاريخ مضبوط بشكل محكم 101% . واجهة للمطور مخصصة بالتفعيل عن بعد . أو بإرسال رقم التفعيل للعميل لاستخدامه بشكل يدوي . سيرفر مدعوم من جوجل مجاني يصل لـ 15 جيجا كحجم بيانات . دعم الصيانة على الأداة المخصصة بالتفعيل 6 شهور بعد البيع . نسخة تجريبية يمكن التحكم بها - الإفتراضية 7 أيام . للتواصل من خلال الواتس أب :- 00962787818180