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

نعم ... اعتذر

السلام عليكم ورحمة الله جرب هذا الملف الرقم القومى2.xlsm

السلام عليكم ورحمة الله تفضل تكت التليفون والعنوان.xls

السلام عليكم ورحمة الله وبركاته على الرغبة السيد @محمد عبد الشفيع من هنا https://www.officena.net/ib/topic/86775-دمج-برنامج-الحماية-مع-برنامج-الفترة-التجريبية تم فتح هذا الموضوع و ان شاء الله ساشرح خطوة خطوة حسب وقتي حتى اخلص من الموضوع وفي النهاية راح اسمع اراء و مقترحاتكم والان نحن نحتاج جدول واحد لكي نحفظ فيه تسلسل و رقم هارد و المعالج و رقم التفعيل البرامج و مدة التفعيل و تاريخ التفعيل و تاريخ اخر مرة فتح البرامج وسنسمي هكذا بالتسلسل كما مبينة في الصورة ID من نوع ترقیم تلقائی NumForMoaalic من نوع نصي NumForHard من نوع نصي NumTascil من نوع نصي Midda من نوع رقم و مصدره يكون عمودين واحد لكتابة رقم ايا عدد ايام التفعيل والاخر لكتابة مثلا يوم واحد او اسبوع واحد هكذا وهذا هو مصدره "1";"يوم واحد";"7";"اسبوع واحد";"30";"شهر واحد";"90";"ثلاث اشهر";"180";"ستة اشهر";"365";"سنة واحدة";"18250";"مدى الحياة" شوف الصورة لكي نعرف خصائص هذا الحقل جيداً و ايضا عندنا حقل باسم firstdate من نوع وقت والتاريخ واخر حقل هو EndDate من نوع وقت والتاريخ وتم تسمية الجدول باسم TblTascil ولان ليس لدي وقت اليوم ان اكون على جهاز لابتوب غدا او يوم السبت ان شاء الله راح اكمل الشرح ونبدأ بعمل النماذج والسلام عليكم ورحمة الله وبركاته

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أثناء تجولي في الإنترنت وجدت ملفاً يعرض معلومات النظام ومنها مثلا سيريال الهارد ديسك رقم المعالج رقم المازر بورد وغيرها الكثير فأحببت مشاركتكم فيه .... أترككم معه وأتمنى تجربة الملف على أنظمة تشغيل مختلفة يعني xp و 7 و vista وسيفن و 8 و 8.1 و 10 وينندوز بالنواة 32 أو 64 وإخباري بالنتيجة SystemInfo.rar

مجهود رائع جدا.. جزاك الله كل خير أستاذ @Shivan Rekany رائع أنك لم تنسى رسائل التنبيه الحقول الفارغة للهارد والمعالج ومدة التفعيل والأروع ..عندما أخترت فترة للبرنامج غير الذي تم تحديدة من الكراك ظهرت الرسالة "اكتب رقم التسجيل .. وحاول مجدداً" أعرف أن الكمال لله تبارك وتعالى، لذا حتى يكتمل البرنامج أعطي لك ملاحظاتي التالية: 1- الأفضل ألغاء ر سالة الألحاق التي تظهر بعد أدخال رقم التسجيل والضغط على زر تسجيل 2- عند التسجيل لثلاثة أشهر ظهرت رسالة "اكتب رقم التسجيل .. وحاول مجدداً" ورقم التسجيل صحيح 3- في ملف الكراك فترة سنة لا يظهر رقم التسجيل 4- يلاحظ أن هناك بطئ عند بدء تشغيل ملف ShivanHimaye 5- ياريت حتى تكتمل الخيارات أضافة ثلاث سنوات وخمس سنوات وعشر سنوات عندي أستفسار: ماهي المدة التي تبداء بظهور رسائل التنبية بقرب نهاية التسجيل؟ طبعاُ يلاحظ ظهورها في فترة اليوم والأسبوع وبالنسبة للبقية متى تبداء بالظهور؟

استاذى الغالى @Shivan Rekany يبدو انك قمت بالتعديل وارفاق الملفات الجديدة بنفس المشاركة ولكنى لم اكن اعلم وكنت بانتظار ان تقوم بمشاركة جديدة بها المرفقات بعد التعديل

أستاذنا @Shivan Rekany تقصد من الرابط السابق.. جاري التحميل وتجربة الملف جزاك الله كل خير

من الصعب جدا ان تجد ذلك وبالنسبة التسجيل في يوم الاخر !!؟ عندما المستخدم يعطيك الرقم الهارد ورقم المعالج ويختار المدة التفعيل بعدين حضرتك سيعطيه الرقم التسجيل وسيخبره بان هذا الكود تقدر تستخدمه في هذا اليوم فقط للتفعيل واذا لا تريد التفعيل الان اتصلني في يوم اللي تريد التفعيل اذا تشوف ان كتير من المواقع مثل فيس بوك و كوكل عند فتح حساب جيميل او ياهو بيرسل لرقم تلفونك كود مكونة من 6 ارقام اذا لا تستخدمه في مدة المحددة بعد ذلك لا يمكنك استخدامه وهذا حماية اخرى لحسابك وبنظري هذا جيد للأسف كان هناك خطأ في الكود ... لكن الان تقدر ان تنزل القاعدة من جديد .. تم اصلاح

سؤال : هل نسخت وحدة النمطية حتى عطيتك ذلك الرسالة ؟ لان لدي ما في مشكلة ولكن بعد حذف الوحدة النمطية بيعطيني نفس الرسالة

بعد اذن اخي علي كود اسرع قليلاُ لا يقوم بقراءة البيانات صفاُ بعد صف Option Explicit Sub tranfer_data() Dim x Dim arr(), k%: k = Sheets.Count - 1 Dim my_rg As Range Set my_rg = Sheets("المنتجات").Range("a1").CurrentRegion For x = 2 To k ReDim Preserve arr(1 To x - 1): arr(x - 1) = Sheets(x).Name Sheets(x).Cells.ClearContents Next For x = LBound(arr) To UBound(arr) my_rg.AutoFilter 1, arr(x) my_rg.SpecialCells(12).Copy _ Sheets(arr(x)).Range("a1") Next Erase arr

السلام عليكم وانا كذلك ، البرنامج عندي شغال 🙂 واليك طريقة اخرى ، مشابهة لطريقة اخي kanory 🙂 في النموذج ، وعلى حدث "فتح النموذج" اكتب هذا الكود: Private Sub Form_Open(Cancel As Integer) str_Title = "الرقم السري مطلوب" str_Prompt = "ادخل الرقم السري" If InputBoxDK(str_Prompt, str_Title) = DLookup("[Pass]", "Pass", "[Pass]") Then MsgBox "الرقم السري صحيح", , "تفضل بالدخول" 'DoCmd.Close DoCmd.OpenForm "employees_F", acNormal Else MsgBox "الرقم السري خاطىء", , "لا يمكنك الدخول" DoCmd.CancelEvent End If End Sub . والذي ينادي الوحدة النمطية: Option Compare Database Option Explicit '-------------------------------------------------------------------- ' ' Copyright 1996-2013 J Street Technology, Inc. ' www.JStreetTech.com ' ' This code may be used and distributed as part of your application ' provided that all comments remain intact. ' ' J Street Technology offers this code "as is" and does not assume ' any liability for bugs or problems with any of the code. In ' addition, we do not provide free technical support for this code. ' ' Code for Password-masked InputBox was originally written by ' Daniel Klann in March 2003 and has been adapted & updaed for 64-bit ' compatiblity '-------------------------------------------------------------------- 'Revised Type Declare for compatability with NT 'Re-revised for 64-bit compatibility #If VBA7 Then Type tagOPENFILENAME lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As Long nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As LongPtr lpfnHook As LongPtr lpTemplateName As Long End Type Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Boolean 'APIs for Password-masked Inputbox Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _ ByVal hHook As LongPtr, _ ByVal ncode As Long, _ ByVal wParam As LongPtr, _ lParam As Any _ ) 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 SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" ( _ ByVal hDlg As LongPtr, _ ByVal nIDDlgItem As Long, _ ByVal wMsg As Long, _ ByVal wParam As LongPtr, _ ByVal lParam As LongPtr _ ) As LongPtr 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 GetCurrentThreadId Lib "kernel32" () As Long Private hHook As LongPtr #Else Type tagOPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As Long nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As Long End Type Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long 'APIs for Password-masked Inputbox 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 hHook As Long #End If 'Constants used by Password-masked Inputbox Private Const EM_SETPASSWORDCHAR As Long = &HCC Private Const WH_CBT As Long = 5 Private Const HCBT_ACTIVATE As Long = 5 Private Const HC_ACTION As Long = 0 #If VBA7 Then Private Function InputBoxPasswordMaskProc( _ ByVal lngCode As Long, _ ByVal wParam As LongPtr, _ ByVal lParam As LongPtr _ ) As LongPtr #Else Private Function InputBoxPasswordMaskProc( _ ByVal lngCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long _ ) As Long #End If 'DO NOT PUT IN VBA ERROR HANDLING 'This is a Windows procedure called by Message loop. On Error Resume Next 'Originally written by Daniel Klann 'Updated for 64-bit compatibility Dim RetVal Dim strClassName As String Dim lngBuffer As Long If lngCode < HC_ACTION Then InputBoxPasswordMaskProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function 'Private Function InputBoxDK( _ Function InputBoxDK( _ Prompt, _ Optional Title, _ Optional Default, _ Optional XPos, _ Optional YPos, _ Optional HelpFile, _ Optional Context _ ) As String 'Originally written by Daniel Klann 'Updated for 64-bit compatibility 'Replicate the functionality of Inputbox function 'while providing password masking. #If VBA7 Then Dim lngModHwnd As LongPtr #Else Dim lngModHwnd As Long #End If Dim lngThreadID As Long On Error GoTo ErrHandler lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf InputBoxPasswordMaskProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook ExitProc: On Error Resume Next Exit Function ErrHandler: Select Case Err.Number Case Else VBA.MsgBox "Error " & Err.Number & " (" & Err.Description & ")" End Select Resume ExitProc Resume 'for Debugging End Function 'Hope someone can use it! . جعفر 983.password.accdb.zip

اهلا بك اخ كريم فى المنتدى لك ما طلبت عملاء.xlsm

تفضل جرب هذا ووافنا بالنتائج test30 أصل.rar

السلام عليكم ورحمة الله وبركاته تفضل وحدة نمطية بسيطة للاخفاء والاظهار Option Compare Database Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Sub HideAccess() Call ShowWindow(Access.hWndAccessApp, 0) End Sub Public Sub ShowAccess() Call ShowWindow(Access.hWndAccessApp, 5) End Sub تحياتي

أرجو أن يكون هذا التعديل مناسبا لما أردت تفضل ووافنا بالنتائج test301.rar

هذا هو كود تحديد السن المطلوب Sub DatedIf_User() Dim ws As Worksheet, Sh As Worksheet, Mh As Worksheet Dim ShName As String, Rng As Range, c As Range Dim LR As Long, VlDate As Variant Application.ScreenUpdating = False Set ws = Sheets(ActiveSheet.Name) VlDate = ws.Range("K4").Value '---------------------------------- LR = ws.Cells(Rows.Count, "C").End(xlUp).Row ws.Range("J6:L" & LR + 1).ClearContents Set Rng = ws.Range("I6:I" & LR) '---------------------------------- If IsEmpty(VlDate) = True Then MsgBox "ãä ÝÖáß ÇÏÎá ÊÇÑíÎ ÍÓÇÈ ÇáÓä" Exit Sub Else On Error Resume Next For Each c In Rng If c.Value <> "" Then YY = Year(VlDate) y = Year(c.Value) mm = Month(VlDate) m = Month(c.Value) dd = Day(VlDate) d = Day(c.Value) If d > dd And m > mm Then c.Offset(0, 1) = dd + 30 - d c.Offset(0, 2) = mm - m + 11 c.Offset(0, 3) = YY - y - 1 ElseIf d > dd And m < mm Then c.Offset(0, 1) = dd - d + 30 c.Offset(0, 2) = mm - m - 1 c.Offset(0, 3) = YY - y Else c.Offset(0, 1) = dd - d c.Offset(0, 2) = mm - m c.Offset(0, 3) = YY - y End If End If Next End If Application.ScreenUpdating = True End Sub

وعليكم السلام 🙂 تفضل طريقة تفعيله . . جعفر

اشكرك جدا وممنون منكم وبارك الله فيكم جميعا

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

السلام عليكم ورحمة الله وبركاته برجاء مراجعة المرفق Employee 02.rar تحياتي

وهذه اداه منتشرة جدا أرسله لي اخي ابوخليل لتمكين المحتوي بمجرد النقر عليه دبل كليك أو نقرة مزدوجة open.zip

أنا عضو جديد ومحظوظ بتواجدي هنا ...... شكرا

رائع أستاذنا الفاضل بارك الله فيك و زادك علمًا

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

وعليكم السلام اهلا بك اخى الكريم فى المنتدى -كان عليك استخدام خاصية البحث فى المنتدى فهناك مواضيع مشابهة لطلبك تفضل : https://www.officena.net/ib/topic/47818-برنامج-تسيير-شركات-النقل-الصغيرة/ بارك الله فيك

أحسنت استاذ ابراهيم بارك الله فيك وزادك الله من فضله

طبعا بعد اذن استاذى الكريم سليم له منا كل المحبة والإحترام عليك بوضع هذه المعادلة لكى تعمل الفورمات =SUMPRODUCT(--($B$2:$B2&$C$2:$C2=$B2&$C2))>1

الاكواد المستخدمة :- نحن استخدمنا هذه الوحدة النمطية بها اربع فانكشن Option Compare Database Public Function NumMoaalic() ' لاستخراج سريال المعالج ' Microsoft WMI Scripting v2.1 library ستحتاج مكتبة Dim varObjectToId As String Dim varSerial As String On Error Resume Next varObjectToId = "Win32_Processor,ProcessorId" Set SWbemSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf(Split(varObjectToId, ",")(0)) varSerial = "" For Each SWbemObj In SWbemSet varSerial = SWbemObj.Properties_(Split(varObjectToId, ",")(1)) varSerial = Trim(varSerial) If Len(varSerial) < 1 Then varSerial = "Unknown value" Next NumMoaalic = varSerial End Function Public Function NumHard() ' لاستخراج سريال ھارد ' Microsoft WMI Scripting v2.1 library ستحتاج مكتبة Dim varObjectToId As String Dim varSerial As String On Error Resume Next varObjectToId = "Win32_OperatingSystem,SerialNumber" Set SWbemSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf(Split(varObjectToId, ",")(0)) varSerial = "" For Each SWbemObj In SWbemSet varSerial = SWbemObj.Properties_(Split(varObjectToId, ",")(1)) varSerial = Trim(varSerial) If Len(varSerial) < 1 Then varSerial = "Unknown value" Next NumHard = varSerial End Function Function TxtToNumber(ByVal C As String) As String ' مساعد لتحويل الحروف والرموز الى الارقام ' حسب ما تريدون تقدرون ان تغير الارقام والحروف حسب رغبتكم Select Case C Case "A", "J", "R": TxtToNumber = 9 Case "B", "K", "S": TxtToNumber = 1 Case "C", "L", "T": TxtToNumber = 7 Case "D", "M", "U": TxtToNumber = 3 Case "E", "N", "V": TxtToNumber = 5 Case "F", "O", "W": TxtToNumber = 8 Case "G", "P", "X": TxtToNumber = 2 Case "H", "Y": TxtToNumber = 6 Case "I", "Q", "Z": TxtToNumber = 4 Case "-", "_", "\", " ", "/", ";", ":": TxtToNumber = "" Case Else TxtToNumber = C End Select End Function Function TxtInTextToNumber(SText) ' لتغيير الحروف والرموز الى الارقام Dim Numbers Dim I As Integer ' سيبحث عن الكل الحروف و الرموز وسيغير حسب فانكشن الاعلى For I = 1 To Len(SText) If IsNumeric(Mid(SText, I, 1)) Then Numbers = Numbers & Mid(SText, I, 1) Else Numbers = Numbers & TxtToNumber(Mid(SText, I, 1)) End If Next TxtInTextToNumber = Trim(Numbers) End Function وفي النموذج استخدمنا هذه الاكواد مع شرح Option Compare Database ' تم اعداد من قبل ' Shivan Rekany شفان ريکاني ' وليس لدينا مانع استخدامه في برامجكم فقط نريد منكم الدعاء Dim WqtTascil As Long ' متغير لتعرف عن الوقت التسجيل Private Sub Form_Load() ' كود عند تحميل النموذج 'On Error Resume Next Dim NumBeforeTascil, NumForTascil ' متغيران واحد لکي نعرف رقم الاول للتسجيل قبل استخدام الوقت والاخر رقم تسجيل الحقيقي Dim Spl() As String, LookAllMNT As String ' متغيران الثاني لكي نعرف كل معلومات في الجدول اذا تم تسجيل البرامج من قبل والاخر للتجزئة المعلومات Dim LookMyNm, LookMyNh, LookMyNTascil ' مساعد تجزئة المعومات Dim FrqDate As Integer ' متغير نستخدم لفرق بين تاريخ التسجيل و الدخول Dim FDate As Date, EDate As Date ' متغيران واحد للتاريخ التسجيل والثاني لاخر مرة لفتح البرامج ' رقم قبل تسجيل يساوي رقم واحد مع تحول سريال المعالج الى الارقام مع تحويل سريال الارد تقسيم واحد مع تحويل سريال الهارد NumBeforeTascil = Trim(Round(((1 & TxtInTextToNumber(NumMoaalic) & TxtInTextToNumber(NumHard)) / (1 & TxtInTextToNumber(NumHard))))) ' جميع المعلومات يساوي جلب بيانات الحقل سريال المعالج و الهارد ورقم التسجيل و مدة التسجيل و تاريخ التسجيل و تاريخ اخر مرة الدخول في جدول تبل التسجيل ' بشرط ان يكون سريال المعالج والهارد في جدول بيكون يساوي مع سريال المعالج والهارد اللي يخررجه الفانكشن LookAllMNT = Nz(DLookup("[NumForMoaalic] & ""|"" & [NumForHard] & ""|"" & [NumTascil] & ""|"" & [midda] & ""|"" &[firstdate] & ""|"" & [EndDate] ", "TblTascil", _ "[NumForHard]='" & NumHard & "'" & "and [NumForMoaalic]='" & NumMoaalic & "'"), "") If LookAllMNT <> "" Then ' اذا يجد المعلوماتولم يكون فارغة Spl = Split(LookAllMNT, "|") ' قم بتجزئة كل المعلوةمات حسب رمز هذا الرمز | ' الان عطينا لكل متغير جزئه حسب ما جلبنا في الجدول LookMyNm = Spl(0): LookMyNh = Spl(1): LookMyNTascil = Spl(2): Me.Midde = Spl(3): FDate = Spl(4): EDate = Spl(5) ' فرق بين تاريخين تاريخ الان مع اضافة مدة التفعيل مع اخر تاريخ الدخول FrqDate = DateDiff("d", Now, DateAdd("d", Me.Midde, FDate)) If Me.Midde.Column(0) = 1 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(FDate, "yyyymmdd") ' وقت التسجيل بيكون هذا النوع ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل * 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil)) * 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 7 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(FDate, "yyyymmdd") + 3 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 3 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 3 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 3) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 30 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 30 WqtTascil = Format(FDate, "yyyymmdd") + 15 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 15 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 15 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 15) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 90 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 90 WqtTascil = Format(FDate, "yyyymm") + 45 ' وقت التسجيل يساوي سنة و شهر زائد 45 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 45 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 45) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 180 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 180 WqtTascil = Format(FDate, "yyyymm") + 90 ' وقت التسجيل يساوي سنة و شهر زائد 90 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 90 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 90) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 365 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 365 WqtTascil = Format(FDate, "yyyymm") + 182 ' وقت التسجيل يساوي سنة و شهر زائد 182 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 182 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 182) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 18250 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 18250 WqtTascil = Format(FDate, "yyyymm") + 9125 ' وقت التسجيل يساوي سنة و شهر زائد 9125 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 9125 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 9125) / 212, ".", ""), 1, 15) End If End If ' اذا احد من رقم التسجيل في جدول او سريال الهارد او المعالج بيكون مخالف مع رقم التسجيل او سريال المعالج او الهارد الجهاز If LookMyNTascil <> NumForTascil Or LookMyNm <> NumMoaalic Or LookMyNh <> NumHard Then Me.LblTxt.Caption = "يجب عليك ان تعمل تسجيل البرامج اولا ... للتسجيل اتصل بالمبرمج " Me.NM = NumMoaalic ' مربع في النموذج اللي باسم نون ميم بيكون يساوي سريال المعالج Me.NH = NumHard ' مربع في النموذج اللي باسم نون ئيج بيكون يساوي سريال الهارد ElseIf FDate > Now Or EDate > Now Then ' اذا اول تاريخ بيكون اكبر من الوقت الحاضر او تاريخ اخر مرة للدخول اكبر من الوقت الحاضر MsgBox "تم تلاعب بتاريخ الجهاز ... وهذا غير مقبول , سيتم اغلاق البرامج" DoCmd.Quit ' اغلاق القاعدة ElseIf FrqDate <= 15 And FrqDate > 0 Then ' اذا فرق بين تاريخين يساوي او اقل من 15 يوم و فرق بين تاريخين اكبر من رقم صفر ' بيظهر الرسالة وبيظهر باقي عدد ايام المتبقية لتفعيل البرامج ويسأل هل يريد تسجيله من جديد اذا يختار نعم If MsgBox("باقي عندك " & "( " & FrqDate & " )" & " يوم لانتهاء فترة التسجيل , هل تريد ان تعمل تسجيل من جديد ؟ ", vbMsgBoxRtlReading + vbYesNo + vbQuestion + vbMsgBoxRight, "تسجيل البرامج") = vbYes Then Me.LblTxt.Caption = "يجب عليك ان تعمل تسجيل البرامج اولا ... للتسجيل اتصل بالمبرمج " Me.NM = NumMoaalic ' مربع في النموذج اللي باسم نون ميم بيكون يساوي سريال المعالج Me.NH = NumHard ' مربع في النموذج اللي باسم نون ئيج بيكون يساوي سريال الهارد Else ' والا DoCmd.OpenForm "frmsereki", acNormal ' فتح نموذج اخر DoCmd.Close acForm, Me.Name ' اغلاق هذا النموذج End If ElseIf FrqDate <= 0 Then ' اذا صفر بيكون اكبر او يساوي فرق بين تاريخين ' يظهر الرسالة ويخبره بان تم انتهاء مدة التفعيل والسؤال عن تسجيل من جديد واذا اختار نعم If MsgBox("انتهت مدة التفعيل البرامج , هل تريد ان تعمل تسجيل من جديد ؟", vbMsgBoxRtlReading + vbYesNo + vbQuestion + vbMsgBoxRight, "تسجيل البرامج") = vbYes Then Me.LblTxt.Caption = "يجب عليك ان تعمل تسجيل البرامج اولا ... للتسجيل اتصل بالمبرمج " Me.NM = NumMoaalic ' مربع في النموذج اللي باسم نون ميم بيكون يساوي سريال المعالج Me.NH = NumHard ' مربع في النموذج اللي باسم نون ئيج بيكون يساوي سريال الهارد Else ' والا اي اذا اختار لا يريد التسجيل من جديد DoCmd.Quit ' سيغلق القاعدة End If Else ' واذا لم يكون هناك اي شيء من الاول DoCmd.OpenForm "frmsereki", acNormal ' فتح نموذج الاخر DoCmd.Close acForm, Me.Name ' واغلاق نموذج الحالي End If DoCmd.SetWarnings False ' اسكات الرسائل التنبيهية ' تحديث اخر تاريخ الدخول في جدول بتاريخ الان DoCmd.RunSQL "UPDATE TblTascil SET TblTascil.EndDate = Now() WHERE (((TblTascil.NumForHard)=NumHard()) AND ((TblTascil.NumForMoaalic)=NumMoaalic()));" DoCmd.SetWarnings True ' تفعيل تنبيهات الافتراضية End Sub Private Sub Tascil_Click() ' كود عند الضغط على زر التسجيل On Error Resume Next ' "1";"7";"30";"90";"180";"365";"18250" Dim NumBeforeTascil, NumForTascil ' متغيران واحد لکي نعرف رقم الاول للتسجيل قبل استخدام الوقت والاخر رقم تسجيل الحقيقي Dim Spl() As String, LookAllMNT As String ' متغيران الثاني لكي نعرف كل معلومات في الجدول اذا تم تسجيل البرامج من قبل والاخر للتجزئة المعلومات Dim LookMyNm, LookMyNh, LookMyNTascil ' مساعد تجزئة المعومات Dim FrqDate As Integer ' متغير نستخدم لفرق بين تاريخ التسجيل و الدخول ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.Midde & "") = 0 Then MsgBox "اختر مدة التفعيل": Me.Midde.SetFocus: Exit Sub ' رقم قبل تسجيل يساوي رقم واحد مع تحول سريال المعالج الى الارقام مع تحويل سريال الارد تقسيم واحد مع تحويل سريال الهارد NumBeforeTascil = Trim(Round(((1 & TxtInTextToNumber(NumMoaalic) & TxtInTextToNumber(NumHard)) / (1 & TxtInTextToNumber(NumHard))))) ' جميع المعلومات يساوي جلب بيانات الحقل سريال المعالج و الهارد ورقم التسجيل و مدة التسجيل و تاريخ التسجيل و تاريخ اخر مرة الدخول في جدول تبل التسجيل ' بشرط ان يكون سريال المعالج والهارد في جدول بيكون يساوي مع سريال المعالج والهارد اللي يخررجه الفانكشن LookAllMNT = Nz(DLookup("[NumForMoaalic] & ""|"" & [NumForHard] & ""|"" & [NumTascil] ", "TblTascil", _ "[NumForHard]='" & NumHard & "'" & "and [NumForMoaalic]='" & NumMoaalic & "'"), "") Spl = Split(LookAllMNT, "|") ' قم بتجزئة كل المعلوةمات حسب رمز هذا الرمز | ' الان عطينا لكل متغير جزئه حسب ما جلبنا في الجدول LookMyNm = Spl(0): LookMyNh = Spl(1): LookMyNTascil = Spl(2) ' فرق بين تاريخين تاريخ الان مع اضافة مدة التفعيل مع اخر تاريخ الدخول FrqDate = DateDiff("d", Now, DateAdd("d", Me.Midde, FDate)) If Me.Midde.Column(0) = 1 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") ' وقت التسجيل بيكون هذا النوع ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل * 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil)) * 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 7 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") + 3 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 3 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 3 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 3) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 30 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 30 WqtTascil = Format(Date, "yyyymmdd") + 15 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 15 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 15 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 15) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 90 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 90 WqtTascil = Format(Date, "yyyymm") + 45 ' وقت التسجيل يساوي سنة و شهر زائد 45 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 45 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 45) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 180 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 180 WqtTascil = Format(Date, "yyyymm") + 90 ' وقت التسجيل يساوي سنة و شهر زائد 90 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 90 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 90) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 365 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 365 WqtTascil = Format(Date, "yyyymm") + 182 ' وقت التسجيل يساوي سنة و شهر زائد 182 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 182 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 182) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 18250 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 18250 WqtTascil = Format(Date, "yyyymm") + 9125 ' وقت التسجيل يساوي سنة و شهر زائد 9125 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 9125 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 9125) / 212, ".", ""), 1, 15) End If If Me.NTascil = NumForTascil Then ' اذا كان رقم التسجيل المدخلة بيكون يساوي مع رقم التسجيل الحقيقي للبرامج If LookAllMNT <> "" Then ' اذا هذه ليس اول مرة يسجل على هذه الجهاز DoCmd.SetWarnings False ' اطفاء تنبيهات الافتراضية للنظام ' تحديث المعلومات في الجدول حسب معلومات التفعيل الجديدة DoCmd.RunSQL "UPDATE TblTascil SET TblTascil.NumForMoaalic = [Forms]![FrmTescil]![NM], TblTascil.NumForHard = [Forms]![FrmTescil]![NH]," & _ "TblTascil.NumTascil = [Forms]![FrmTescil]![NTascil], TblTascil.Midda = [Forms]![FrmTescil]![Midde], TblTascil.firstdate = Now(), " & _ " TblTascil.EndDate = Now() WHERE (((TblTascil.NumForMoaalic)=NumMoaalic()) AND ((TblTascil.NumForHard)=NumHard()));" DoCmd.SetWarnings True ' تشغيل تنبيهات الافتراضية للنظام Else ' واذا هذه المرة هي اول مرة للتسجيل ' اضافة معلومات التفعيل الى جدول DoCmd.SetWarnings False ' اطفاء تنبيهات الافتراضية للنظام DoCmd.RunSQL "INSERT INTO TblTascil ( NumForMoaalic, NumForHard, NumTascil, Midda, firstdate, EndDate ) " & _ "SELECT [Forms]![FrmTescil]![NM] AS Expr1, [Forms]![FrmTescil]![NH] AS Expr2, [Forms]![FrmTescil]![NTascil] AS Expr3," & _ "[Forms]![FrmTescil]![Midde] aS Expr4, Now() AS Expr5, Now() AS Expr6;" DoCmd.SetWarnings True ' تشغيل تنبيهات الافتراضية للنظام End If MsgBox "تم تسجيل البرامج لمدة " & Me.Midde.Column(1) ' اظهار رسالة ويظهر للمستخدم ان تم تفعيل لمدة المحددة DoCmd.OpenForm "frmsereki", acNormal ' فتح نموذج الاخر DoCmd.Close acForm, Me.Name, acSaveYes ' اغلاق النموذج الحالية وهو نموذج التسجيل ElseIf Len(Me.NTascil & "") = 0 Then ' اذا كان مربع نصي لرقم التسجيل بيكون فارغا MsgBox "اکتب رقم التسجيل ... وحاول مجددأ" ' اظهار رسالة ويخبره بان رقم التسجيل المدخلة خطأ Me.NTascil.SetFocus 'تركيز على مربع نصي لرقم التسجيل في النموذج Else ' والا MsgBox "خطأ في رقم التسجيل ... حاول مجددأ" ' اظهار رسالة ويخبره بان رقم التسجيل المدخلة خطأ Me.NTascil = "" 'قم بافراغ مربع نصي رقم التسجيل في نموذج Me.NTascil.SetFocus 'تركيز على مربع رقم التسجيل في نموذج End If End Sub Private Sub BtnQuit_Click() ' كود عند ضغط على زر اغلاق ' اغلاق القاعدة DoCmd.Quit End Sub وراح نستخدم هذين فانكشنين في وحدة نمطية في قاعدة كراك هو نفس وحدة الفانكشن الاعلى اللس استخدمناه في القاعدة اللي نعطيه للعميل Option Compare Database Function TxtToNumber(ByVal C As String) As String Select Case C Case "A", "J", "R": TxtToNumber = 9 Case "B", "K", "S": TxtToNumber = 1 Case "C", "L", "T": TxtToNumber = 7 Case "D", "M", "U": TxtToNumber = 3 Case "E", "N", "V": TxtToNumber = 5 Case "F", "O", "W": TxtToNumber = 8 Case "G", "P", "X": TxtToNumber = 2 Case "H", "Y": TxtToNumber = 6 Case "I", "Q", "Z": TxtToNumber = 4 Case "-", "_", "\", " ", "/", ";", ":": TxtToNumber = "" Case Else TxtToNumber = C End Select End Function Function TxtInTextToNumber(SText) Dim Numbers Dim I As Integer For I = 1 To Len(SText) If IsNumeric(Mid(SText, I, 1)) Then Numbers = Numbers & Mid(SText, I, 1) Else Numbers = Numbers & TxtToNumber(Mid(SText, I, 1)) End If Next TxtInTextToNumber = Trim(Numbers) End Function مع هذا الكود في النموذج التسجيل في قاعدة كراك Option Compare Database ' تم اعداد من قبل ' Shivan Rekany شفان ريکاني ' وليس لدينا مانع استخدامه في برامجكم فقط نريد منكم الدعاء Private Sub Tascil_Click() ' كود عند الضغط على زر التسجيل On Error Resume Next Dim NumBeforeTascil, NumForTascil ' متغيران واحد لکي نعرف رقم الاول للتسجيل قبل استخدام الوقت والاخر رقم تسجيل الحقيقي Dim WqtTascil ' ھو رقم من التاريخ لکي يقسم عليھ رقم قبل التسجيل ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.Midde & "") = 0 Then MsgBox "اختر مدة التفعيل": Me.Midde.SetFocus: Exit Sub ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.NM & "") = 0 Then MsgBox "اكتب رقم المعالج": Me.NM.SetFocus: Exit Sub ' اذا كان كومبوبوكس مدة التفعيل في النموذج بيكون خالي من البيانات يظهر رسالة ويخبره و يركز على الكومبوبوكس وينتهي مشوار ضغط على الزر If Len(Me.NH & "") = 0 Then MsgBox "اكتب رقم الهارد": Me.NH.SetFocus: Exit Sub ' رقم قبل تسجيل يساوي رقم واحد مع تحول سريال المعالج الى الارقام مع تحويل سريال الارد تقسيم واحد مع تحويل سريال الهارد NumBeforeTascil = Trim(Round(((1 & TxtInTextToNumber(Me.NM) & TxtInTextToNumber(Me.NH)) / (1 & TxtInTextToNumber(Me.NH))))) If Me.Midde.Column(0) = 1 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") ' وقت التسجيل بيكون هذا النوع ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل * 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil)) * 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 7 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 1 WqtTascil = Format(Date, "yyyymmdd") + 3 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 3 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 3 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 3) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 30 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 30 WqtTascil = Format(Date, "yyyymmdd") + 15 ' وقت التسجيل يساوي سنة و شهر و يوم زائد 15 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 15 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 15) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 90 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 90 WqtTascil = Format(Date, "yyyymm") + 45 ' وقت التسجيل يساوي سنة و شهر زائد 45 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 45 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 45) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 180 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 180 WqtTascil = Format(Date, "yyyymm") + 90 ' وقت التسجيل يساوي سنة و شهر زائد 90 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 90 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 90) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 365 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 365 WqtTascil = Format(Date, "yyyymm") + 182 ' وقت التسجيل يساوي سنة و شهر زائد 182 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 182 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 182) / 212, ".", ""), 1, 15) ElseIf Me.Midde.Column(0) = 18250 Then ' اذا كان عمود المرقم بصفر في كومبوبوكس مدة بيكون يساوي رقم 18250 WqtTascil = Format(Date, "yyyymm") + 9125 ' وقت التسجيل يساوي سنة و شهر زائد 9125 ' ورقم التسجيل بيكون 15 ارقام من تقسيم رقم قبل التسجيل تقسيم وقت التسجيل ضرب 9125 تقسيم 212 و استبدال نقطة (.) ب لا شيء NumForTascil = Mid(Replace(((NumBeforeTascil / WqtTascil) * 9125) / 212, ".", ""), 1, 15) End If Me.NTascil = NumForTascil ' مربع رقم التسجيل يساوي رقم التسجيل End Sub Private Sub BtnQuit_Click() ' كود عند ضغط على زر اغلاق ' اغلاق القاعدة DoCmd.Quit End Sub * قاعدة الكراك راح يكون عند المبرمج والاخر سيكون في قاعدة بيانات البرامج اللي يعمله المبرمج ويعطيه للعميل * من الممكن ان يتغير ارقام اي نوع عطاء رقم التفعيل حسب الرغة اتمنى ان يستفيد منه اكبر عدد ممكن من الاعضاء تقبلوا تحياتي ShivanHimaye.rar

بعد اذن المكتبة طبعاٌ تحسين بسيط على الكود لنحصل على نطاق اكبر Private Sub TextBox1_Change() On Error Resume Next If ActiveSheet.AutoFilterMode = True Then: ActiveSheet.ShowAllData If (Me.TextBox1.Value) = "" Then: ActiveSheet.AutoFilterMode = False: GoTo 1 Range("B6:K" & Cells(Rows.Count, "k").End(3).Row).AutoFilter Field:=1, Criteria1:="=*" & TextBox1.Text & "*", Operator:=xlAnd Exit Sub 1: End Sub

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

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

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة قائمة منسدلة مطاطية من صفحة اخرى تم ارفاق كود الحل من الفاضل/ سليم حاصبيا _ ياسر خليل أبو البراء و لا تنسونا من صالح الدعاء تحياتى Watchطريقة عمل قائمة منسدلة_فيديو_yaser.rar قائمة منسدلة 4yaser).rar google combo (سليم).rar قائمة منسدلة_سليم salim.rar

تفضل تم اعداد مثال بالمطلوب مع بعض التحسين عدد الكلمات المتولدة سيكون تبعا لعدد الحروف المدخلة وتقريبا سينتج : 3 حروف = 6 كلمات 4 حروف = 24 كلمة 5 حروف = 120 كلمة 6 حروف = 680 كلمة 7 حروف = 3137 كلمة بالنسبة لـ 6 حروف و 7 فالعدد الناتج تقريبي توليد كلمات من حروف محددة.rar

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