محمد أبوعبدالله

السلام عليكم تفضل اخي الكريم Option Compare Database Option Explicit Private Const IDC_HAND = 32649& Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long Private Sub Cmd01_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) SetCursor LoadCursor(0, IDC_HAND) End Sub تحياتي

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

السلام عليكم اضف الوحدة النمطية التالية Option Compare Database Option Explicit Function CalcAgeY(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeY = vYears End Function Function CalcAgeM(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeM = vMonths End Function Function CalcAgeD(vDate1 As Date, vdate2 As Date) As String Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If Day(vDate1) = 31 Then vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) - 1 If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeD = vDays End Function واستخدم الكود التالي في النموذج Me.الخبره_يوم = CalcAgeD(Me.تاريخ_نهايه_مدة_الخبره, Me.تاريخ_اليوم) Me.الخبره_شهر = CalcAgeM(Me.تاريخ_نهايه_مدة_الخبره, Me.تاريخ_اليوم) Me.الخبره_سنه = CalcAgeY(Me.تاريخ_نهايه_مدة_الخبره, Me.تاريخ_اليوم) Me.استثنائيه_يوم = CalcAgeD(Me.تاريخ_نهايه_المدة_استثنائيه, Me.تاريخ_بدايه_المدة_استثنائيه) Me.استثنائيه_شهر = CalcAgeM(Me.تاريخ_نهايه_المدة_استثنائيه, Me.تاريخ_بدايه_المدة_استثنائيه) Me.استثنائيه_سنه = CalcAgeY(Me.تاريخ_نهايه_المدة_استثنائيه, Me.تاريخ_بدايه_المدة_استثنائيه) ونصيحة لا تستخدم اسماء عربية للحقول والكائنات ان اردت استخدام دوال ومعادلات Database1.rar تحياتي

نعم يمكن استخدام دالة nz اذا كان حقلي التاريخ فارغاً Frook3: CalcAgem(Nz([AGAM1];0);Nz([AGAM2];0))+IIf(CalcAgeD(Nz([AGAM1];0);Nz([AGAM2];0))>22;1;0) UP-New Microsoft Access 11111.rar تحياتي

تفضل اخي الكريم Private Sub سنة_التأهيل_Click() If DLookup("[سنة التأهيل]", "STABLE2-2", "[AA ID]=" & [AA ID] & " AND [سنة التأهيل]='" & [سنة التأهيل] & "'") > 1 Then ' Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) MsgBox "هذا العام مكرر من قبل" Me.Undo Exit Sub Else Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) + 1 End If End Sub data2.rar تحياتي

من الطبيعي الا يكرر نفس العام ولكن على كل حال قم بتعديل الكود كالتالي Private Sub سنة_التأهيل_Click() If Me.[سنة_التأهيل] = DLast("[سنة التأهيل]", "STABLE2-2", "[AA ID] = " & [AA ID]) Then Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) Else Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) + 1 End If End Sub data1.rar تحياتي ولعدم تكرر العام استخدم الكود التالي If Me.[سنة_التأهيل] = DLookup("[سنة التأهيل]", "STABLE2-2", "[AA ID] = " & [AA ID]) Then ' Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) MsgBox "هذا العام مكرر من قبل" Me.Undo Exit Sub Else Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) + 1 End If

اذن نقوم بتعديل الوحدة النمطية ونجعلها لا تقسم على 12 كالتالي Option Compare Database Option Explicit Function CalcAgeY(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeY = vYears End Function Function CalcAgeM(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths 'Mod 12 CalcAgeM = vMonths End Function Function CalcAgeD(vDate1 As Date, vdate2 As Date) As String Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If Day(vDate1) = 31 Then vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) - 1 If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths 'Mod 12 CalcAgeD = vDays End Function ويكون في الاستعلام كالتالي Frook3: CalcAgem([AGAM1];[AGAM2])+IIf(CalcAgeD([AGAM1];[AGAM2])>22;1;0) UP-New Microsoft Access 11111.rar تحياتي

هذا من مميزات / عيوب تنسيق الحقل AutoNumber / ترقيم تلقائي عند عملية الضغط والاصلاح يبدأ الترقيم من جديد اذا كان الجدول فارغ واذا لم يكن فارغ يبدأ من اخر رقم مسجل بالحقل +1 لذلك الافضل دائماً لا تستخدم ترقيم تلقائي كترقيم للفاتورة ولكن استخدام حقل رقم ومن خلال الكود اضافة ترقيم للفواتير تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم هذه محاولة حسب ما فهمت Private Sub سنة_التأهيل_Click() Me.strtawgod = Nz(DMax("strtawgod", "STABLE2-2", "[AA ID] = " & [AA ID]), 0) + 1 End Sub تحياتي

بالاضافة الى ما تفضل به الاخوة ولهم الشكر تفضل اخي الكريم اضف هذه الوحدة النمطية Option Compare Database Option Explicit Function CalcAgeY(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeY = vYears End Function Function CalcAgeM(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeM = vMonths End Function Function CalcAgeD(vDate1 As Date, vdate2 As Date) As String Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If Day(vDate1) = 31 Then vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) - 1 If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeD = vDays End Function ثم في الاستعلام ادرج التالي Frook3: DateDiff("m";[AGAM1];[AGAM2])+IIf(CalcAgeD([AGAM1];[AGAM2])>22;1;0) UP-New Microsoft Access 11111.rar تحياتي

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

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم الحساب عن طريق الجمع التركمي Expr1: Nz(DSum("nz(ts)";"Table1";"[N°]<=" & [N°] & " and nom='" & [nom] & "'" & " and Designation='" & [Designation] & "'");0) test.rar تحياتي

يمكن استخدامها في كل ذلك يمكن الاستخدام كمصدر عنصر تحكم / control source او في الحقل المسحوب [salary]*[tax] وفي vba في الحدث المناسب لك فيمكن استخدامه في حدث قبل التحديث للنموذج او في الحالي او عند الخروج من عنصر salary تحياتي

وعليكم السلام ورحمة الله وبركاته كل الطرق صحيحة ما دامت تعطي النتيجة صحيحة وذلك حسب حاجة العمل فاحيانا نلجأ الى استخدام العمليات الحسابية واحيانا في vba =nz([salary])*nz(tax) تحياتي

السلام عليكم اخي @أبو عبدالله الحلوانىهل جربت ادخال اسماء مكررة مثل محمد محمد محمود احمد عبدالله عبدالله عبدالرحمن عبدالرحيم احمد احمد السيد محمود تحياتي

اخي الكريم هل تستخدم كود لاخفاء شاشة اكسيس وعند اغلاق النماذج يحدث ذلك ؟ اذا كانت الاجابة نعم اذن عليك اضافة كود انهاء اكسيس في النموذج الرئيسي اذا كانت الاجابة لا فالمشكلة اذن بالاكسيس نفسه يحتاج الى ازالة وتثبيت من جديد ولانهاء اكسيس على كل حال بدون اعادة تشغيل الجهاز اضغط Control + Alt + Delete تظهر قائمة المهام اختار اكسيس قم بانهائه تحياتي

جرب اخي الكريم الموضوع التالي تحياتي

السلام عليكم يمكن استخراج الارقام من النص عن طريقة الدالة التي وضعها استاذنا جعفر في الموضوع التالي Function Seperate_Digits(T) If Len(T & "") = 0 Then Seperate_Digits = "" Exit Function End If For i = 1 To Len(T) C = Asc(Mid(T, i, 1)) Select Case C Case 46, 48 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) End Select Next i Seperate_Digits = Which_Letter End Function الاشكالية اذا كان هناك اكثر من رقم في نفس الحقل كما في مثالك سيتم دمج الرقمين فتكون النتيجة 2015232105 أما في الحقل الذي به رقم واحد ستكون النتيجة 13626 تحياتي

وعليكم السلام ورحمة الله وبركاته استخدم دالة NZ لتفادي الحقول الفارغة بتعويضها بصفر Me.txt3 = m(Nz(Me.txt1, 0), Nz(Me.txt2, 0)) function.rar تحياتي

السلام عليكم في نموذج login استبدل كالتالي If pas = DLookup("userpass", "TblUsers", "username ='" & [usr] & "'") Then 'DoCmd.Close Me.Visible = False DoCmd.OpenForm "Home" Else MsgBox "يوجد خطأ في اسم المستخدم او كلمة المرور" DoCmd.Close End If واضف الكود التالي لنموذج Home Private Sub Form_Open(Cancel As Integer) DoCmd.RunMacro "mcrHide" If DLookup("username", "TblUsers", "username=forms!login!usr") <> "admin" Then Me.أمر15.Visible = False Me.أمر6.Visible = False Me.أمر5.Visible = False Me.usr.Visible = False Else Me.أمر15.Visible = True Me.أمر6.Visible = True Me.أمر5.Visible = True Me.usr.Visible = True End If End Sub كاشير.rar تحياتي

السلام عليكم لاعادة ترتيب الارقام استخدم نفس الكود بالاضافة الى الكود التالي mySQL = "Select * From [مسند] Order By HNO" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst CurrentDb.Execute "UPDATE [مسند] SET [مسند].HNO = Null" For i = 1 To rst.RecordCount rst.Edit rst!HNO = i rst.Update rst.MoveNext Next Me.Requery مسند.rar تحياتي

وعليكم السلام ورحمة الله وبركاته هل تريد تكرار جميع الارقام بالجدول ( ارقام الفواتير ) ؟ ام اخر رقم فاتورة ؟ ام السجل الحالي ؟ ارفق مثال للتوضيح بارك الله فيك تحياتي

السلام عليكم تفضل اخي الكريم On Error GoTo Err: '1 '=================================================== mySQL = "Select * From Table1" Set rst = CurrentDb.OpenRecordset(mySQL) '=================================================== '2 rst.MoveLast rstMax = rst!DAT.Value rst.MoveFirst rstMin = rst!DAT.Value rstDate = rstMin rstTemp = rstMin rst.MoveNext '=================================================== '3 While rst.EOF = False And rstTemp < rstMax rstTemp = rst!DAT.Value XNew = DateAdd("d", 1, rstDate) Do While DateDiff("d", XNew, rstTemp) >= 1 And XNew < rstMax rst.AddNew rst!DAT.Value = XNew rst.Update XNew = DateAdd("d", 1, XNew) Debug.Print XNew Loop rstDate = rstTemp rst.MoveNext Wend MsgBox "تم اضافة التواريخ المفقودة بنجاح", vbInformation, "Officena" '=================================================== Err: MsgBox "لا توجد بيانات في الجدول", vbInformation, "Officena" New Microsoft Access Database (2).rar تحياتي وهذه نفس الطريقة ولكن لاضافة التواريخ المفقودة في جدول منفصل On Error GoTo Err: '1 '=================================================== mySQL = "Select * From Table1" Set rst = CurrentDb.OpenRecordset(mySQL) mySQL3 = "Select * From Tablel3" Set rst3 = CurrentDb.OpenRecordset(mySQL3) '=================================================== '2 rst.MoveLast rstMax = rst!DAT.Value rst.MoveFirst rstMin = rst!DAT.Value rstDate = rstMin rstTemp = rstMin rst.MoveNext '=================================================== '3 While rst.EOF = False And rstTemp < rstMax rstTemp = rst!DAT.Value XNew = DateAdd("d", 1, rstDate) Do While DateDiff("d", XNew, rstTemp) >= 1 And XNew < rstMax rst3.AddNew rst3!DAT.Value = XNew rst3.Update XNew = DateAdd("d", 1, XNew) Debug.Print XNew Loop rstDate = rstTemp rst.MoveNext Wend MsgBox "تم اضافة التواريخ المفقودة بنجاح", vbInformation, "Officena" '=================================================== Err: MsgBox "لا توجد بيانات في الجدول", vbInformation, "Officena" New Microsoft Access Database (2).rar تحياتي

نستخدم دالة iif هكذا iif ([txtbox1]<40 ;[txtbox1];"") تحياتي

السلام عليكم يمكن استخدم الكود التالي للتحكم في اظهار واخفاء الحقل If Me.txtbox1 < 40 Then Me.txtbox1.Visible = False Else Me.txtbox1.Visible = True End If تحياتي