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

وعليكم السلام-اجعل المعادلة هكذا =IF($M$1="زيت 20لتر",(SUMIFS($F$1:$F$5,$B$1:$B$5,$M$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0))+SUMIFS($F$1:$F$5,$B$1:$B$5,$N$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0)))/(20*SUMIFS($D$1:$D$5,$B$1:$B$5,$M$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0))+IF($N$1="زيت 5لتر",$K$1*SUMIFS($D$1:$D$5,$B$1:$B$5,$N$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0))))) ورقة عمل1 Microsoft Excel جديد.xlsx

السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد وذلك حتى نتأكد من عدم حدوث تكرار وطبعا كالعادة سوف اقدم لكم اليوم فكرتى المتواضعة فى هذا الشأن من خلال استخدام وظيفة عامة تعمل كروتين من خلال وحدة نمطية بحيث يتم اسناد القيم التى تخص كل من القيمة واسم الحقل واسم الجدول الى متغيرات عامة ليتم الفحص يعنى مثل ما سوينا من قبل مع المعرف الخاص البرمجى هنا فى هذا الموضوع '|-----------------------------------------------------------| '|---15/09/1443-------16/04/2022_____________________________| '|___www.officena.net________________________________________| '| | '| _ +-----------officena-----------+ _ | '| /o) | ||||| | (o\ | '| / / | @(~O^O~)@ | \ \ | '| ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| (\\\ \_/ / \ \_/ ///) | '| \ / \ / | '| \____/________Mohammed Essam________\____/ | '| 15/09/1443 | '| 16/04/2022 | '| | '|_____www.officena.net______________________________________| '|_____Thank you for visiting https://www.officena.net_______| '|-----------------------------------------------------------| '======Check Input Exist By Input Type======================================================================================================================================' ' ____ __ ____ ____ __ ____ ____ __ ____ ______ _______ _______ __ ______ _______ .__ __. ___ .__ __. _______ .___________. ' ' \ \ / \ / / \ \ / \ / / \ \ / \ / / / __ \ | ____|| ____|| | / || ____|| \ | | / \ | \ | | | ____|| | ' ' \ \/ \/ / \ \/ \/ / \ \/ \/ / | | | | | |__ | |__ | | | ,----'| |__ | \| | / ^ \ | \| | | |__ `---| |----` ' ' \ / \ / \ / | | | | | __| | __| | | | | | __| | . ` | / /_\ \ | . ` | | __| | | ' ' \ /\ / \ /\ / \ /\ / __| `--' | | | | | | | | `----.| |____ | |\ | / _____ \ __| |\ | | |____ | | ' ' \__/ \__/ \__/ \__/ \__/ \__/ (__)\______/ |__| |__| |__| \______||_______||__| \__| /__/ \__\ (__)__| \__| |_______| |__| ' ' ' '===========================================================================================================================================================================' Public Function CheckInputExist( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ ByVal strObjectContainFieldValue) As Boolean On Error GoTo ErrorHandler Dim strFormName As Access.Form Dim stLinkCriteria As String Dim strMsgTitel As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strErrMsgTitel As String Dim strErrMsg As String Set strFormName = Screen.ActiveForm strMsgPrt1 = ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1593") & ChrW("1579") & ChrW("1608") & ChrW("1585") & ChrW("32") & ChrW("1593") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("40") & ChrW("160") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") & ChrW("1578") & ChrW("1602") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function Select Case FieldTypeName(strFieldName, strTableName) Case Is = "Text": stLinkCriteria = strFieldName & "= '" & strObjectContainFieldValue & "'" Case Is = "Date/Time": stLinkCriteria = strFieldName & "= #" & Format(strObjectContainFieldValue, "dd/mm/yyyy") & "#" Case Is = "Long Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Byte": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Single": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Double": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Decimal": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue End Select If DCount("*", strTableName, stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & strObjectContainFieldValue & strMsgPrt2, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" strFormName.Undo strFormName.Recordset.FindFirst stLinkCriteria Else End If procDone: Exit Function ErrorHandler: strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") strErrMsg = ChrW("1604") & ChrW("1602") & ChrW("1583") & ChrW("32") & ChrW("1581") & ChrW("1575") & ChrW("1608") & ChrW("1604") & ChrW("1578") & ChrW("32") & ChrW("1573") & _ ChrW("1583") & ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1576") & ChrW("1610") & _ ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & _ ChrW("1610") & ChrW("1581") & ChrW("46") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & _ ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1575") & _ ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") & ChrW("32") & ChrW("1607") & ChrW("1608") & ChrW("32") & _ ChrW("40") & ChrW("32") & FieldTypeName(strFieldName, strTableName) & ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1605") & ChrW("1606") & ChrW("32") & _ ChrW("1601") & ChrW("1590") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1576") & ChrW("1573") & ChrW("1583") & _ ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & _ ChrW("1578") & ChrW("1578") & ChrW("1591") & ChrW("1575") & ChrW("1576") & ChrW("1602") & ChrW("32") & ChrW("1605") & ChrW("1593") & ChrW("32") & ChrW("1606") & _ ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") _ & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") Select Case Err.Number Case Is = 2471: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Is = 3075: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Else MsgBox$ Err.Number & ": " & Err.Description End Select Resume procDone End Function Public Function FieldTypeName(ByRef strFieldName As String, ByRef strTableName As String) As String Dim db As DAO.Database Dim objRecordset As DAO.Recordset Dim i As Integer Set objRecordset = CurrentDb.OpenRecordset(strTableName) For i = 0 To objRecordset.Fields.Count - 1 If strFieldName = objRecordset.Fields(i).Name Then Dim strReturn As String Select Case CLng(objRecordset.Fields.Item(i).Type) 'fld.Type is Integer, but constants are Long. Case dbBoolean: strReturn = "Yes/No" ' 1 Case dbByte: strReturn = "Byte" ' 2 Case dbInteger: strReturn = "Integer" ' 3 Case dbLong ' 4 If (objRecordset.Fields.Item(i).Attributes And dbAutoIncrField) = 0& Then strReturn = "Long Integer" Else strReturn = "AutoNumber" End If Case dbCurrency: strReturn = "Currency" ' 5 Case dbSingle: strReturn = "Single" ' 6 Case dbDouble: strReturn = "Double" ' 7 Case dbDate: strReturn = "Date/Time" ' 8 Case dbBinary: strReturn = "Binary" ' 9 (no interface) Case dbText '10 If (objRecordset.Fields.Item(i).Attributes And dbFixedField) = 0& Then strReturn = "Text" Else strReturn = "Text (fixed width)" '(no interface) End If Case dbLongBinary: strReturn = "OLE Object" '11 Case dbMemo '12 If (objRecordset.Fields.Item(i).Attributes And dbHyperlinkField) = 0& Then strReturn = "Memo" Else strReturn = "Hyperlink" End If Case dbGUID: strReturn = "GUID" '15 'Attached tables only: cannot create these in JET. Case dbBigInt: strReturn = "Big Integer" '16 Case dbVarBinary: strReturn = "VarBinary" '17 Case dbChar: strReturn = "Char" '18 Case dbNumeric: strReturn = "Numeric" '19 Case dbDecimal: strReturn = "Decimal" '20 Case dbFloat: strReturn = "Float" '21 Case dbTime: strReturn = "Time" '22 Case dbTimeStamp: strReturn = "Time Stamp" '23 'Constants for complex types don't work prior to Access 2007 and later. Case 101&: strReturn = "Attachment" 'dbAttachment Case 102&: strReturn = "Complex Byte" 'dbComplexByte Case 103&: strReturn = "Complex Integer" 'dbComplexInteger Case 104&: strReturn = "Complex Long" 'dbComplexLong Case 105&: strReturn = "Complex Single" 'dbComplexSingle Case 106&: strReturn = "Complex Double" 'dbComplexDouble Case 107&: strReturn = "Complex GUID" 'dbComplexGUID Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal Case 109&: strReturn = "Complex Text" 'dbComplexText Case Else: strReturn = "unknown" End Select End If Next i FieldTypeName = strReturn End Function يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى Call CheckInputExist("FieldName", "TableName", Me.txtBox) وأخيرا المرفق للتجربة ملاحظة : تم تعديل المرفق والكود بناء على رد استاذى الجليل الباش مهندس @Moosak التعديل النهائى بتحديث المرفق بتاريخ يوم السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول Check Input Exist.accdb

في نموذج التواريخ مثل ما تلاحظ قمت بنسخ نفس القيمة المسجلة مسبقا ثم ضغطت على Check ولكن لم يعطيني رسالة تأكيد وجود التاريخ مسبقا 🙂

طيب ممكن نضيف السطر الاتى للكود وتم التعديل فى المرفق الرئيسي If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function لكن لم افهم

بعد بسم الله الرحمن الرحيم 😎 جزيل الشكر والإمتنان لك مهندسنا الغالي @ابو جودي بس عندي ليك كم ملاحظة 😏 أول ملاحظة ( لما يكون الحقل فاضي ) وهذا ينطبق على كل أنواع البيانات : الملاحظة الثانية ( بعض القيم لا يتم اكتشافها ) على الرغم من أنها موجودة مسبقا ( وينطبق على التواريخ ) : والباقي زي العسل على الطحينة 😉

بارك الله فيكم وفي علمكم وجعله في ميزان حسناتكم على ما تعلمون الناس الخير

فضل هذه المحاولة في حدث عند الفتح ضح الكود التالي [id_n].DefaultValue = Year(Now()) & DCount("*", "T_takrir") + 1 [id_n].Format = "0000 - 0" مرفق التعديل جورج الطويل.accdb

كل الاحترام استاذ محمد بالعكس اضافاتك مميزة وتضفي اثراء للمشاركات كل عام وانتم بخير

السلام عليكم ورحمة الله وبركاته إخوتي الكرام: تم التحكم بحجم البيانات من خلال طريقة العمل التالية: ثم وضع ذلك في الكود Sub طباعة() ActiveWindow.SelectedSheets.PrintOut copies:=2 End Sub __________________________________________________________________________________________________________________________________ أعتذر للأستاذ الكريم نزار سليمان عيد لم أشاهد مشاركته إلا بعد أن شاركت بها وعلى كل هذا رافد ...والتنوع طيب ... بارك الله بكم تقبلوا مروري والسلام عليكم طبع الصفحات التي تحتوي على بيانات.xlsx123 (1).xlsm

Why five lines while it can be done in one line Me.TextBox1.Value = Cells(ActiveCell.Row, 1).Value

1 Dim stLinkCriteria As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strMsgPrt3 As String strMsgPrt1 = ChrW("1578") & ChrW("1581") & ChrW("1584") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1588") & ChrW("1582") & ChrW("1589") & ChrW("1609") & ChrW("32") & ChrW("40") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("32") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1575") & ChrW("1605") & ChrW("1607") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("1602") & ChrW("1576") & ChrW("1604") strMsgPrt3 = ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1606") & ChrW("1602") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1606") & ChrW("32") & ChrW("1573") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("46") stLinkCriteria = "[idnumber ]=" & Me.idnumber If DCount("*", "tblName", stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & Me.idnumber & strMsgPrt2 & vbCr & vbCr & strMsgPrt3, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" Me.Undo Me.Recordset.FindFirst stLinkCriteria Else End If فقط غير tblName الى اسم الجدول تبعك

السلام عليكم ورحمة الله يوضع هذا الكود فى حدث الفورم Private Sub CommandButton1_Click() Dim C As Range x = ActiveCell.Row Set C = Cells(x, 1) y = C.Value Me.TextBox1.Value = y End Sub

بالإشارة إلى تعدد الإستفسارات حول تطبيق لاستخدام المنتدى على الهاتف المحمول يرجى الاحاطة بان التطبيق المتوفر هو من نوع PWA Progressive Web App (PWA) اذا تصفحت الموقع باستخدام آخر اصدارات الكروم ، www.officena.net ستجد تنبيه منبثق بعنوان اضافة officena الي الشاشة الرئيسية: و بالضغط عليه سيتم تحميل التطبيق و في حال لم يظهر الاشعار السابق يمكن الضعط على الثلاث نقاط اعلي صفحة المنتدى من الهاتف و اختيار تثبيت التطبيق او بالانجليزية Add to Home Screen و سيتم اضافة ايقونة للتطبيق

شرح كيفية اظهارمتعدد الصفحات من اليمين وطريقتين للتنقل بين الصفحات مع عقاب الله لكل من كذب الانبياء الملف الانبياء واوالدعوة.xlsm

طيب يا استاذ @Moosak ,واستاذ @abouelhassan من فضلكم تجربة المرفق فى رأس الموضوع مرة أخرى تم تحديث المرفق السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول والباش مهندس @Eng.Qassim ممكن حضرتك توضح قصدك من أو تفضل وتكرم علينا بالتعديل المناسب كما تراه ربما كانت نظرتكم وفكرتم افضل بكثير

استاذ موسى اعتقد المشكلة عندك في اعدادات اللغة لان التاريخ شغال معاي ... الان لنستفيد من ابداعات شخابيط استاذنا @ابو جودي ليكون اختبار النصوص جميعها في نموذج واحد

اخي استخدم هذا الفورم افضل بأكثر من 100 مره Userform_Updated_15_Columns.xlsm

طب 2 / 10 على الأقل عشان أول واحد مجاوب والعيش والملح 😅 خلاص أنا هجاوبك في موضوعك الأصلي عشان عندي كم ملاحظة 😏

أشكر أخويّ الكريمين على هذه الكلمات الدافئة بارك الله بكما وجعل ذلك بموازين حسناتكما. فمن لم يشكر الناس لم يشكر الله. والسلام عليكم

وهذا تطبيق على برنامجك 🙂 حبيت أجرب كود الباش مهندس 😄🖐🏼️ جورج الطويل.accdb

الله يجبر بخاطرك اخى موسى مهندس مره واحده ياعم انا غلبان وع قد حالى انا بقراء العربى بالعافيه 😀 ربنا يعزك ويبارك فيك 🌹 طب يالا شد الهمه واتجدعن قبل ما المعلم يدخل ويشد الحزام 😀🌹 بالتوفيق

تحتاج لهذا الكود Sub PrintA() 'prints rows of data, will not print rows if column A is blank Application.ScreenUpdating = False Range("A:A").EntireRow.Hidden = False Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ActiveWindow.SelectedSheets.PrintOut Copies:=1 Range("A:A").EntireRow.Hidden = False Application.ScreenUpdating = True End Sub او هذا الكود Sub PrintSummary() Dim myrange As String myrange = Cells(Rows.Count, 17).End(xlUp).Address ActiveSheet.PageSetup.PrintArea = "$A$1:" & myrange Application.Goto Reference:="R1C1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False End Sub فضلا انظر للمرفق طبع الصفحات التي تحتوي على بيانات.xlsx123 (1).xlsm

اخى واستاذى عمر ابوتامر كل عام وانت بخير وحمدالله على السلامه ومتغبش عن اخوانك كتير وجزاك الله خيرا الذى يقصده السائل انه الشيت الموجود الحالى عند الطباعه سوف يطبع 8 صفحات والمفروض يطبع صفحتان من معاينه فواصل الصفحات بالتوفيق

وعليكم السلام ورحمه الله وبركاته الله اكرم اطلع ع هذا الموضوع وجزاه الله خيرا ابوجودى وحاول تعدل لوحدك حتى تستفيد بالتوفيق

جزاكى الله خيرا وحعلها الله فى ميزان حسناتك

اللهم آمين واياكم قمت بالتجربه الان فلم ارها هل قمت بتفعيل الاعدادت الخاصه بالاشعارات ادخلى على الاعدادت وراجعيها مره اخرى وان لم يكن اعملى اشاره للاستاذ محمد طاهر وسوف يقوم بالاطلاع عالمشكله والرد عليها باذن الله قمت بعمل اشاره للاستاذ محمد طاهر هناك لملاحظه الموضوع وان شاء الله يتم الرد عليها من قبل الاستاذ محمد طاهر حول هذه النقطه بالتوفيق

وعليكم السلام ورحمه الله وبركاته موجود معاينه قبل النشر اضغط ع الزر المعلم بالاحمر بالصوره بالتوفيق

ايوه شايف ده اخى العزيز موسى ولكن ما قصدته بالرجوع لمشاركه اخى العزيز ابوجودى فنظرتى للتعديل عالوضع الحالى كحقل واحد بتغير المتغير IDField بتغيير اسم المتغير مثلا strField من نوع Variant ليحمل اى نوع من القيم ثم نقوم بفحص المتغير اذا كان رقم او نص او تاريخ او نعم ولا وبعدها نكمل باقى الكود ولما ترجع true or false هل ساقوم بفحص النتيجه فالنموذج ايضا ام ماذا ؟ وسؤالى بقا لاخى العزيز @ابو جودي هل الفكره اللى قصدتها ع نوع واحد ام بكتابه روتين عام يشمل ( اذا كان رقم او نص او تاريخ او نعم ولا ) لكل الحالات فردى او ثنائى او ثلاثى او رباعى ؟ وفقكم الله واعانكم لما فيه كل خير تقبلوا تحياتى ومرورى ومتابع

وعليكم السلام ورحمه الله وبركاته ممكن مرفق حتى يتثنى لاخوانك واساتذتنا مساعدتك بشكل افضل بالنسبه لنسخ الكود وبه كتابه عربى فقم بتغيير اللغه من الجهاز الى العربيه قبل النسخ ثم انسخ والصق فى المحرر بشكل طبيعى بالتوفيق

والسؤال الان للباش مهندس @Moosak فاكر الكود الذكى بتاع الترقيم التلقائى تقدر تحول الكود السابق لكود ذكى يتم وضعه فى وظيفة عامة داخل وحدة نمطية ومن خلال متغيرات نقدر نستدعيه لاى جدول واى حقل للتأكد من وجود التكرار من عدمه وفى حالة وجود التكرار يذهب للسجل اللى به التكرار يلا شخبط انت المره دى وفرجنا شخابيطك

وعليكم السلام ورحمه الله وبركاته الله اكرم يجب عليك استخدام البحث اولا ستجد الكثير من المواضيع عن كيفيه منع التكرار واليك احد هذه المواضيع ان لم تستطع فعليك برفع مثال لما تريد حت يتثنى لاخوانك واساتذتنا مساعدتك بشكل افضل بالتوفيق

واضافه الى ما سبق ولكن باستخدام استعلام فرعى بداخل الاستعلام qryBySubQry انظر الحقل فى وضع التصميم RSabek RSabek: (SELECT nz(Sum([Daen]),0)-nz(Sum([MDeen]),0) FROM tblName WHERE (((NewtblName.SName)=[SName]) AND ((NewtblName.SDate)>[sdate]))) بالتوفيق TestRseedSabk_BySubQry.accdb

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير افتح الاستعلام فى وضع التصميم واقف على الحقل RSabek هتلاقى موجود به داله DSum RSabek: Nz(DSum("[daen]-[mdeen]";"tblName";"SName='" & [SName] & "' And [id]<" & [id]);0) جمع حقل الدائن ناقص المدين من الجدول بشرط الاسم يكون مساوى للاسم بالاضافه لرقم العمليه اللى هو الترقيم التلقائى اقل من الرقم اللى قبله , ويمكن استعمال التاريخ بدلا منه وفى حقل Rseed Rseed: ([RSabek]+[Daen])-[Mdeen] قمنا بجمع الرصيد السابق + الدئن ناقص المدين ومرفق تعديل للمثال باستخدام التاريخ بدلا من الترقيم التلقائى RSabek: Nz(DSum("[daen]-[mdeen]";"tblName";"SName='" & [SName] & "' And [SDate]<" & Format([SDate];"\#mm\/dd\/yyyy\#"));0) بالتوفيق TestRseedSabk_ByDate.accdb

وعليكم السلام ورحمة الله وبركاته بارك الله فيك أستاذنا ابو جودي وإذا ممكن ارسل لي التفعيل على الخاص🙂 و تقبل الله منا ومنك صالح الأعمال

جزاك الله خيرا اخى واستاذى محمد @ابو جودي 🌹 من فضلك ارسل لى

جزى الله أخانا الفاضل *محمد طاهر* خير الجزاء، فقد سعدت جدا بالمشاركة حيث كنت قد اقترحت توفير هذه الخاصية منذ سنتين تقريبا على المنتدى، وقد وفقكم الله - وله الحمد والمنة- في تقديم هذه الميزة الطيبة. وأحب أضيف طريقة إظهار رابط التطبيق على جوالات أيفون لمستخدميها حيث تختلف طريقة الإضافة في حال استخدام سفاري Safari عن الطريقة المعروضة. وهي خطوات بسيطة كما يلي: ١- الضغط على زر مشاركة الصفحة من المتصفح. ٢- تمرير قائمة خيارات المشاركة للأعلى حتى يظهر أمر إضافة التطبيق للشاشة الرئيسية.

ممتاز استاذ محمد بارك الله فيك -عمل ممتاز وبالفعل سيفيد العديد من الأعضاء .. أكرمك الله والى النجاح والتقدم دائما لمنتدانا

تفضل هذه الجزئية DateDiff('yyyy',[EmpBirthDate],Now()) Between " & _ Me.txtFrom & " And " & Me.txtTo

تطبيق الفاتورة الاكترونية حسب متطلبات هيئة الزكاة و الضريبة السعودية كما انه تم الاستفادة من الكود الخاص بالأستاذ / @ابو جودي رابط الموضوع يمكن التجربة من خلال الرابط التالي InvoiceSA.somee.com كما يمكن تحميل المشروع للمطورين من خلال الرابط اعلاه

من فضلك طريقة الدخول الأن الى المنتدى بإميلك وليس بإسم المستخدم ... فإذا أردت الدخول فيجب عليك كتابة الإميل ... وشكراً

طيب ... تفضل ... Dim rst As Recordset '' Dim ast_1, ast_3, ast_4, ast_10, ast_11, ast_12, ast_t, cast_1 As Integer Set rst = CurrentDb.OpenRecordset("tb_mbd", dbOpenDynaset) With rst .MoveFirst Do While Not .EOF .Edit If rst!case_cod.Value = 1 Or rst!case_cod.Value = 2 Or rst!case_cod.Value = 4 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 6 rst!m_es_4.Value = rst!m_bg1 * 0 rst!m_es_10.Value = rst!m_bg1 * 0 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 3 Or rst!case_cod.Value = 5 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 6 rst!m_es_4.Value = rst!m_bg1 rst!m_es_10.Value = rst!m_bg1 * 0 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 * 0 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 6 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 5 rst!m_es_4.Value = rst!m_bg1 rst!m_es_10.Value = rst!m_bg1 * 0 rst!m_es_11.Value = rst!m_bg1 * 2 rst!m_es_12.Value = rst!m_bg1 * 0 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 7 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 5 rst!m_es_4.Value = rst!m_bg1 * 0 rst!m_es_10.Value = rst!m_bg1 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 8 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 5 rst!m_es_4.Value = rst!m_bg1 * 0 rst!m_es_10.Value = rst!m_bg1 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 * 0 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If .Update .MoveNext Loop End With '' Call t rst.close MsgBox "تم التحديث"

وانت في صحة وسلامة ...... اخي خالد ... دقق في البيانات هل هذه النتيجة هي المطلوبة ,,,

مبروك الأستاذ حسونة إنضمامك لعائلة الخبراء ,أسأل الله لك التوفيق والنجاح دائما ..وأعانك الله على هذه المسئولية الجديدة وسدد الله خطاك عن حق وجدارة بارك الله فيك وزادك الله من فضله

نعم ممكن اختزاله ... وذلك بتعديل مسميات مربعات النص قليلا .... انظر الكود وحاول قرائته ..... وسوف ارفق المرفق قريبا ..... myT = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس") For Each t In myT If Me.to.Value = t Then For i = 1 To 8 If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] =" & i), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] =" & i), "hh:mm:ss AMPM") Then Me.Controls(t & i).BackColor = vbYellow End If Next i End If Next t

اللهم امين -بارك الله فيك استاذ مجدى وجزاك الله خير الثواب

طيب جرب يوم الاحد كدة ...... If Me.to.Value = "الأحد" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac1.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac2.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac3.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac4.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac5.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac6.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac7.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac8.BackColor = vbYellow End If End If timetable 2022 (3) (1).accdb

بارك الله فيك وجزاك الله كل خير

شكراً جزيلاً لهذا المجهود وجزاك الله خير الثواب

وعليكم السلام يمكنك ذلك بهذه المعادلة بعد ادخال وكتابة كود الصنف سيتم احضار اسم الصنف وكذلك بمعادلة أخرى إيجاد سعر الصنف =IFERROR(VLOOKUP($C12,'الصنف والسعر'!$A$2:$D$2100,2,0),"") فاتورة جديدة8.xls

استخدم الدالة التالية اكتب مصدر الحقل المراد الترقيم فيه كما يلي =RowNum([Forms]![Data]) حيث data هو اسم النموذج ضع الدالة التالية في موديول جديد Public Function RowNum(frm As Form) As Variant On Error GoTo Err_RowNum 'Purpose: Numbering the rows on a form. 'Usage: Text box with ControlSource of: =RowNum([Forms]![theNameoftheForm]) With frm.RecordsetClone .Bookmark = frm.Bookmark RowNum = .AbsolutePosition + 1 End With Exit_RowNum: Exit Function Err_RowNum: If Err.Number <> 3021& Then 'Ignore "No bookmark" at new row. Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description End If RowNum = Null Resume Exit_RowNum End Function