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

جرب التالي على نفس المثال اعلاه Private Sub أمر16_Click() DoCmd.GoToRecord , , acGoTo, CurrentRecord + DCount("*", "1", "id=form!id") End Sub العفو ابا جودي ولك وحشة تحياتي للجميع

قم بتغيير اسم الورقة الاولى الى Main يجب ان يكون الجدول بشكل يغهمه الاكسل (لا أعمدة فارغة ) لذلك وضغت صفاً فارغاً بحيث يبدأ الحدول من الصف رقم 3 وجرب هذا الماكرو Option Explicit Sub SUPER_ADV_FILTER() Application.ScreenUpdating = False Dim i%: i = 4 Dim arr Dim ws As Worksheet: Set ws = Sheets("Main") Dim rg As Object Dim rg_to_copy As Range Set rg_to_copy = ws.Range("a3").CurrentRegion Set rg = CreateObject("system.collections.arraylist") With rg Do Until ws.Range("d" & i) = vbNullString If Not .contains(UCase(ws.Range("d" & i).Value)) _ Then .Add UCase(ws.Range("d" & i).Value) i = i + 1 Loop For i = 0 To .Count - 1 On Error Resume Next If Len(Sheets(.Item(i)).Name) = 0 Then Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = .Item(i) End If On Error GoTo 0 Next End With Set rg = Nothing For i = 2 To Sheets.Count Sheets(i).Range("T1") = "رقم القيد" Sheets(i).Range("T2") = Sheets(i).Name rg_to_copy.AdvancedFilter 2, Sheets(i).Range("T1:T2"), Sheets(i).Range("A3") Sheets(i).Range("T1:T2") = vbNullString Next Application.ScreenUpdating = True End Sub الملف مرفق tarhil_salim.xlsm

نعم توجد .. كما في المثال المرفق : عندما تفتح النموذج NTJS1 فبمجرد ادخال اول حرف من اسم الطالب يظهر باقي الاسم ويستمر عند تشابه الاسماء NEW.accdb

اخي الكريم كيف تريد تعديل على المثال والوحدة نمطية يوجد بها رقم سري واخيرا كما قال الاستاد فارس بني هلال وكل معلومات محدوفة هل تريد المساعدة ام مضيعة الوقت هل المثال يستاهل كل هدا { إاثنان لا يتعلمان المستحي والمتكبر } انت في هدا المنتدى مع اكبر مبرمجي الاكسس الشيخ ابو خليل,استاد جعفر,الاستادShivan Rekany وغيرهم من الاساتدة الموجودين الدين يعطون من وقتهم ولا يملون

هل هذا هو المطلوب ؟ basem.rar

وعليكم السلام-تفضل Basem.xlsx

تم اضافة هذا Me.datex = DateAdd("m", 1, Me.datex) على كودك الموجود وصار هكذا Private Sub أمر5_Click() On Error GoTo Err_أمر5_Click Dim Eded As Integer Dim I As Integer Eded = InputBox("اکتب عدد سجلات التکرار", "عدد الكرارات") DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70 DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70 For I = 1 To Eded DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append Me.datex = DateAdd("m", 1, Me.datex) Next Exit_أمر5_Click: Exit Sub Err_أمر5_Click: MsgBox Err.Description Resume Exit_أمر5_Click End Sub access test (1).mdb

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

استخدم هذا Private Sub أمر2_Click() Me.datex = DateAdd("m", 1, Me.datex) End Sub

السلام عليكم حولي نوع مصدر الصف الى :: جدول/ استعلام مصدر الصف :: حددي الحقل المطلوب في عبارة sql من الجول واجعليه تجميع حسب الكلام موجه للعضو MemeQ

بعد إذن الأستاذ مصطفى محمود أكمل بنفس نمط المعادلة في باقي المواد احصاء مدارس.xls

لاحظ المعادلات في اللغة العربية اذا كانت صحيحة كما تريد بالامكان عملها على بقية المواد تحياتي لكم +++احصاء مدارس.xls

أخى الكريم من فضلك حدد بالضبط وبالتفصيل على الملف ما هو المطلوب -فالمثال المرفوع غير واضح وغير دقيق للتوضيح بارك الله فيك

الاكواد المستخدمة :- نحن استخدمنا هذه الوحدة النمطية بها اربع فانكشن 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