استأذن من استاذ @kanory
اذا تريد ان يكون يضاف 5 سنوات كل مرة بدل سنة واحدة اتفضل اليك هذا
Private Sub أمر24_Click()
On Error GoTo g:
On Error Resume Next
Dim i As Integer
Dim X As Date
Dim DATE_POST As Date
Dim MyYear As Integer
DoCmd.GoToRecord , , acNewRec
For i = 0 To Forms![test1]![no] - 1
MyYear = i * 5
Me.serial = Forms![test1]![serial]
Me.date1 = DateAdd("yyyy", MyYear, Forms![test1]![Date_M])
Me.no = DateAdd("D", i, Forms![test1]![no1])
DoCmd.GoToRecord , , acNext
'On Error Resume Next
Next
g: Exit Sub
End Sub
test2000.mdb
عفوا ما عندي اي كتاب لكن في الاسفل بها روابط ممكن تستفيد منها https://support.office.com/ar-sa/article/الخاصية-تنسيق-نوع-البيانات-تاريخ-وقت-3251a423-3dd7-446e-be65-c7293eddbb43
وهنا ايضا
https://support.office.com/ar-sa/article/تخصيص-تنسيقات-البيانات-في-Access-e48f2312-67f0-4921-aca0-15d36b7f9c3b
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim intShiftDown As Integer, intAltDown As Integer
Dim intCtrlDown As Integer
' Use bit masks to determine which key was pressed.
intShiftDown = (Shift And acShiftMask) > 0
intAltDown = (Shift And acAltMask) > 0
intCtrlDown = (Shift And acCtrlMask) > 0
' Display message telling user which key was pressed.
If KeyCode = vbKeyF1 And intShiftDown Then MsgBox "تم الضغط على مفتاح شيفت و ايف وان": KeyCode = 0
If KeyCode = vbKeyF1 And intAltDown Then MsgBox "تم الضغط علي مفتاح الت و ايف وان": KeyCode = 0
If KeyCode = vbKeyF1 And intCtrlDown Then MsgBox "تم الضغط على مفتاح كنترول و ايف وان": KeyCode = 0
End Sub
ان شاء الله خلاص مافي المشاكل بعد
اي الان ان شاء الله
نعم والان صار كود في الحال للنموذج الى
Private Sub Form_Current()
On Error GoTo HandleErr
Dim rs As Object
If Not IsNull([PicFile]) Then
[imgPicture].Picture = [PicFile]
SysCmd acSysCmdSetStatus, "Image: '" & [PicFile] & "'."
Set rs = Me.Recordset.Clone
rs.FindFirst "[Name_b] = '" & Me![مربع_تحرير_وسرد96] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
Else
[imgPicture].Picture = ""
SysCmd acSysCmdClearStatus
End If
Exit Sub
HandleErr:
If Err = 2220 Then
[imgPicture].Picture = ""
SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile] & "'"
Set rs = Me.Recordset.Clone
rs.FindFirst "[Name_b] = '" & Me![مربع_تحرير_وسرد96] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
Else
MsgBox Err.Description, vbExclamation
End If
End Sub
واليك ملفك بعد تعديل
test50.rar
شوف اخي قصدي ان تكتب في اول الكود الزر ذاك الجملة
واذا كم مرة بيعمل كانسل للنافذة ما يظهر اي رسالة
والان انا جربت
وايضان كود تابعك هم بنتهي الامر
On Error Resume Next
STR_TITLE = "ÔÇÔÉ ÇÖÇÝÉ ÇíÇã"
STR_PROMPT = "ÃÏÎá ÚÏÏ ÇáÇíÇã ááÊÃÌíá"
X = InputBox(STR_PROMPT, STR_TITLE)
If X > 0 Then
Me.TimerInterval = 1
End If
كون معي
اولا حذفنا الارتباط تبعك
وثانيا عملنا استعلام بهذا الشكل لنموذج فرعي
وكتبنا كود بداخله لكي يتم عرض جميع الاسماء او يظهر اللي اللي في كومبوبوكس فقط
شوف الصورة
وشوف نموذج الفرعي
ذاك الاستعلام هو مصدر بياناته
و عملنا استعلام داخلي لكومبوبوكس وبها حقلين حقل الاسم و حقل اي دي
شوف الصورة
ولانه استعلامن بها حقلين كتبنا رقم 2 كما مبينة في الصورة الادناه
و في حدث بعد تحديث لكومبوبوكس كتبنا كود اللي في صورة ادناه
جزء الاول لكود بيبحث في نموذج رئيسي
والجزء الثاني بيعمل ريكويري لنموذج فرعي
مع تقدير
السلام عليكم ورحمة الله
اتفضل اخي اليك هذا الكود
Private Sub BtnDelete_Click()
If Me.NewRecord = True Then Exit Sub
Dim MyPass, MyId
MyPass = InputBox("للحذف السجل اكتب رقم سري الخاص بالحذف السجلات", "تأكيد الحذف")
If MyPass = 9999 Then
MyId = Me.ID
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdSelectRecord
DoCmd.RunCommand acCmdDeleteRecord
DoCmd.SetWarnings True
MsgBox "تم حذف السجل رقم " & " ( " & MyId & " ) " & "بنجاح"
ElseIf Len(MyPass & "") = 0 Then
MsgBox "تم الغاء العملية الحذف"
Else
MsgBox "خطأ في رقم سري الخاص لحذف السجلات"
End If
End Sub
واليك ملف تطبيقي
اتفتضل
تم اضافة هذا الكود عند فتح النموذج
Private Sub Form_Open(Cancel As Integer)
If Me.اسم__المستخدم = 1 Then
Me.Form.RecordSource = "ادخال البيانات"
Else
Me.Form.RecordSource = "SELECT [ادخال البيانات].ID, [ادخال البيانات].[اسم الموقع], [ادخال البيانات].الرخصة, [ادخال البيانات].النشاط, [ادخال البيانات].المنطقة, [ادخال البيانات].[حالة الموقع], [ادخال البيانات].[رقم الهاتف الارضى], [ادخال البيانات].[رقم الهاتف المتحرك], [ادخال البيانات].[اسم مسؤول الموقع], [ادخال البيانات].الايميل, [ادخال البيانات].العدد, [ادخال البيانات].[اسم المستخدم] FROM [ادخال البيانات] WHERE ((([ادخال البيانات].[اسم المستخدم])=[Forms]![ادخال بيانات المواقع]![اسم المستخدم]));"
End If
End Sub
واليك قاعدتك بعد اضافة الكود
Dim Numbers
if len(SText & "")=0 then
GetNumbersOnly=""
exit function
end if
For i = 1 To Len(SText)
If IsNumeric(Mid(SText, i, 1)) and Mid(SText, i, 1) <> 0 Then
Numbers = Numbers & Mid(SText, i, 1)
End If
Next
GetNumbersOnly = Trim(Numbers)
اتفضل تم اضافة هذا جزء فقط
and Mid(SText, i, 1) <> 0
الاكواد المستخدمة :-
نحن استخدمنا هذه الوحدة النمطية بها اربع فانكشن
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
* قاعدة الكراك راح يكون عند المبرمج والاخر سيكون في قاعدة بيانات البرامج اللي يعمله المبرمج ويعطيه للعميل
* من الممكن ان يتغير ارقام اي نوع عطاء رقم التفعيل حسب الرغة
اتمنى ان يستفيد منه اكبر عدد ممكن من الاعضاء
تقبلوا تحياتي
اكمال الشرح مع استاذ ابو عبدالله
كما تفضل الاستاذ عندك في القاعدة جدول باسم Temp3 وبها عدد من الحقول و اسماءها F1 , F2 ,F3,F4,F5,F6,F7,F8,F9 >>> الى اخره
هنا يقول الكود اذا حقل اللي اسمه F مع قيمة fld_Number وهو 3 زائد 16 اي يعني اللي اسمه F19 بيكون رقم يعمل الاتي
sID = حرف F مع 3 زائد 16 اي يعني F19
sName = حرف F مع 3 زائد 12 اي يعني F15
وهكذا
اي يعني قيمة fld_Number هو 3 مع زيادة رقم المكتوب معه بيساوي اسم الحقل المطلوب
للعلم في رابط مشاركتك الاعلى انا قمت بتعديل الكود و كتبت في نهاية اسطر اسم الحقل
تقبل تحياتي
وعليكم السلام ورحمة الله وبركاته
اتفضل اليك هذا
Option Compare Database
Function RiaziyatTxtToNum(SText)
' By Shivan Rekany
Dim i, ii As Integer
Dim Elamat
Dim Encam As Double
Dim sERCEM As Double
Dim JimaaZuF As Integer
For ii = 1 To Len(SText)
If Mid(SText, ii, 1) = "+" Or Mid(SText, ii, 1) = "*" Or Mid(SText, ii, 1) = "/" Or Mid(SText, ii, 1) = "-" Then
JimaaZuF = JimaaZuF + 1
End If
Next ii
Dim LString As String
Dim LArray() As String
LString = Replace(Replace(Replace(SText, "+", "*"), "-", "*"), "/", "*")
LArray = Split(LString, "*", Val(JimaaZuF + 1))
For ii = 1 To Len(SText)
If Mid(SText, ii, 1) = "+" Or Mid(SText, ii, 1) = "*" Or Mid(SText, ii, 1) = "/" Or Mid(SText, ii, 1) = "-" Then Elamat = Elamat & Mid(SText, ii, 1)
Next ii
Encam = Val(LArray(0))
For i = 1 To Len(Elamat)
If Mid(Elamat, i, 1) = "+" Then
Encam = Encam + Val(LArray(i))
ElseIf Mid(Elamat, i, 1) = "*" Then
Encam = Encam * Val(LArray(i))
ElseIf Mid(Elamat, i, 1) = "/" Then
Encam = Encam / Val(LArray(i))
ElseIf Mid(Elamat, i, 1) = "-" Then
Encam = Encam - Val(LArray(i))
End If
Next i
RiaziyatTxtToNum = Trim(Encam)
Form_TBL1.sERCEM = RiaziyatTxtToNum
End Function
واليك ملف تم تطبيق عليه
عليكم السلام ورحمة الله وبركاته
في مرة السابقة ايضا كان مشكلتك نفس المشكلة
خلي توضح لك لكي تستفيد اكثر
القي نظرتا الى هذه الصورة
هناك حقل باسم bi لكن مصدره هو حقل user1
وفي مصدر التقرير والنموذج الغياب هناك شرط فيه وهو يجب ان يكون حقل bi يساوي بحقل bi في جدول الملفات1
اي يجب ان يكون مصدر حقل bi في جدول ملفات1 يكون حقل bi نفسه
لذلك انا قمت بتسمية مربع bi الى user1 ومن جديد اضفت حقل bi في نموذج
اتفضل اليك قاعدتك بعد تعديل
،عم استخدم هذا الكود
Private Sub AGE_AfterUpdate()
If Not IsNull(Me.Age.Value) Then
Me.DOB.Value = DateSerial(Year(Me.dDate) - Me.Age.Value, 1, 1)
End If
End Sub
2020 (1).rar
اليك طريقتين
لكن في البداية القي نظرتا الى خصائص كومبوبوكس قي هذه الصورة
اذا تريد ان يكتب فيه ولا يقبل شيء احد غير اللي في مصدره استخدم هذا الكود معه
Private Sub green_NotInList(NewData As String, Response As Integer)
Response = Cancel
End Sub
لكن اذا تريد ان لا يكتب فيه حرف واحد فقط يجوز ان تختار استخدم هذا الكود معه
Private Sub Combo3_KeyDown(KeyCode As Integer, Shift As Integer)
KeyCode = 0
End Sub
واليك المرفق بها كلا من طريقتين