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

اعتقد ان المرفق الذى قمت بعمله هو طلبك ويمكن لك ان تعدل فى الكود حسب طلبك او الاليه التى تريد بها تشغيل الكود وما قمت بعمله هو تعديل الكود الخاص بك Private Sub Form_Timer() Dim TT As Integer TT = TimeValue("11:59:59 PM") Me.t1 = Time() Me.t2 = TT - Me.t1 End Sub

طيب الحل ببساطة يكون t2 = DateAdd("N", 1, Format(#11:59:59 PM# - Time(), "HH:MM:SS"))

هل هذا ما تريد ؟ time.accdb

الوقت المتبقى على شو ما فهمت عليك والبخور ما بينفع برمضان الله يرضى عنيك وضح

انظر للمرفق على وجه السرعة ..لاقتراب وقت اذان الفجر exemple.rar

مش سامع حد بيرد يعنى

بس فى فرق دقيقه ماليش دعوة اناا عاوز الدقيقة دى بقه

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

عندك حل الاستاذ محمد حسن بالمعادلات

اخي شاهد المرفق ملاحظة : لن استجيب لأي مشاركة لك الا اذا كانت كاملة المعلومات والتواريخ تغطي كل الاحتمالات كود.xlsb

السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد وذلك حتى نتأكد من عدم حدوث تكرار وطبعا كالعادة سوف اقدم لكم اليوم فكرتى المتواضعة فى هذا الشأن من خلال استخدام وظيفة عامة تعمل كروتين من خلال وحدة نمطية بحيث يتم اسناد القيم التى تخص كل من القيمة واسم الحقل واسم الجدول الى متغيرات عامة ليتم الفحص يعنى مثل ما سوينا من قبل مع المعرف الخاص البرمجى هنا فى هذا الموضوع '|-----------------------------------------------------------| '|---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

ضع الوظيفة الاتية فى وحدة نمطية Option Compare Database Option Explicit #If VBA7 Or Win64 Then Public Declare PtrSafe Function apiGetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal flag As Long) As Long Public Declare PtrSafe Function apiEnableMenuItem Lib "user32" Alias "EnableMenuItem" (ByVal hMenu As Long, ByVal wIDEnableMenuItem As Long, ByVal wEnable As Long) As Long #Else Public Declare Function apiEnableMenuItem Lib "user32" Alias "EnableMenuItem" (ByVal hMenu As Long, ByVal wIDEnableMenuItem As Long, ByVal wEnable As Long) As Long Public Declare Function apiGetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hWnd As Long, ByVal flag As Long) As Long #End If Const MF_BYCOMMAND = &H0& Const MF_DISABLED = &H2& Const MF_ENABLED = &H0& Const MF_GRAYED = &H1& Const SC_CLOSE = &HF060& Const SWP_NOSIZE = &H1 Const SWP_NOZORDER = &H4 Const SWP_NOMOVE = &H2 Const SWP_FRAMECHANGED = &H20 Const WS_MINIMIZEBOX = &H20000 Const WS_MAXIMIZEBOX = &H10000 Const WS_SYSMENU = &H80000 Public Function EnableDisableControlBoxX(bEnable As Boolean, Optional ByVal lhWndTarget As Long = 0) As Long On Error GoTo Err_EnableDisableControlBoxX Dim lhWndMenu As Long Dim lReturnVal As Long Dim lAction As Long lhWndMenu = apiGetSystemMenu(IIf(lhWndTarget = 0, Application.hWndAccessApp, lhWndTarget), False) If lhWndMenu <> 0 Then If bEnable Then lAction = MF_BYCOMMAND Or MF_ENABLED Else lAction = MF_BYCOMMAND Or MF_DISABLED Or MF_GRAYED End If lReturnVal = apiEnableMenuItem(lhWndMenu, SC_CLOSE, lAction) End If EnableDisableControlBoxX = lReturnVal Exit_EnableDisableControlBoxX: Exit Function Err_EnableDisableControlBoxX: MsgBox "Error:" & Err.Number & vbCrLf & "Description: " & Err.Description Resume Exit_EnableDisableControlBoxX End Function ويمكنك عدم تفعيل زر الاغلاق من خلال EnableDisableControlBoxX False ويمكنك الرجوع للوضع الاصلى بإعادة فاعلية زر الاغلاق من EnableDisableControlBoxX True

بسيطة وذلك من خلال هذا الكود .. سيتم تفعيله من أيقونة تصفير ,,, الموجودة بالصفحة الرئيسية Sub ResetForm_Click() Dim ws As Worksheet With Worksheets("الصندوق") .Range("C3:J40").ClearContents End With Worksheets("كشف عميل").Range("b4:c4").ClearContents With Worksheets("المبيعات") .Range("a3:g40").ClearContents End With Worksheets("كشف مورد").Range("b4:c4").ClearContents With Worksheets("المشتريات") .Range("a3:g40").ClearContents End With With Worksheets("العملاء الموردين") .Range("C2:C40").ClearContents .Range("E2:I40").ClearContents End With With Worksheets("أصناف المبيعات") .Range("a3:E200").ClearContents End With With Worksheets("اصناف المشتريات") .Range("a3:E200").ClearContents End With With Worksheets("الأصناف") .Range("B3:B40").ClearContents .Range("D3:I40").ClearContents End With With Worksheets("الموردين") .Range("A4:B200").ClearContents End With With Worksheets("شيكات") .Range("B4:B200").ClearContents End With End Sub Data_All1.xlsm

او في Formt النص ضع HH:mm:ss

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

جزاك الله خيرا اخى ومهندسنا العزيز @Eng.Qassim ع مشاركتك معنا الحلول واثراء الموضوع 🌹 ويوجد طريقه اخرى من باب اثراء الموضوع وتنوع الحلول باستخدام TempVar انشى مديول جديد وضع تعريف المتغير فقط Public intID As TempVar ثم فى حدث الحالى للنماذج قم بالاسناد كالتالى TempVars!intID = Me.ID.Value ثم فى الاستعلام وفى المعيار للمعرف [TempVars]![intID] بالتوفيق

كيف ممكن اجعل نظام الوقت 24 وليس 12 ؟!! @عمر ضاحى @ابو جودي @Eng.Qassim

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

اعتقد باني اجبتك عن سؤالك في مشاركتك السابقة واليك النموذج جورج الطويل.accdb

وهذا ان شاء الله يلبى طلبك

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

وعليكم السلام دالة التحقق من النموذج النشط Function IsFormLoaded(StrForm As String) As Boolean Dim frm As Form For Each frm In Forms If frm.Name = StrForm Then IsFormLoaded = True Exit Function End If Next End Function نعمل سبروتين لفتح التقرير حسب المعيار لديك.. نقوم باستدعائه من زر في النماذج الثلاث Sub openR() If IsFormLoaded("F_Asset_Addnew") Then DoCmd.OpenReport "Asset_AddnewR", acViewPreview, "AssetID=" & [Forms]![F_Asset_Addnew]![AssetID] ElseIf IsFormLoaded("F_Asset_Addnew_withoutfilter") Then DoCmd.OpenReport "Asset_AddnewR", acViewPreview, "AssetID=" & [Forms]![F_Asset_Addnew_withoutfilter]![AssetID] Else DoCmd.OpenReport "Asset_AddnewR", acViewPreview, "AssetID=" & [Forms]![F_Asset_Edit]![AssetID] End If End Sub لاني حاولت مع الاستعلام فلم افلح

سورى خطأ مطبعى 😀 هى وتم التعديل goID

السلام عليكم ورحمة الله تعالى وبركاته إصلاح مشاكل قواعد البيانات أداة لاستعادة البيانات الناجمة عن تلف قواعد البيانات تستخدم تقنيات متقدمة لفحص قواعد بيانات Microsoft Access التالفة وتدعم النسيقات (.mdb . accdb) وتقوم باستعادة أكبر قدر ممكن من البيانات مما يقلل الخسارة الناجمة عن تلف قواعد البيانات. الاداة مجانية للاستخدام الغير تجارى من يريد الكراك يراسلنى على الخاص حتى لا ننتهك قوانين المنتدى بنشرها 159905355_DataNumenAccessRepair.rar

بالتوفيق يارب

السلام عليكم ورحمة الله وبركاته أخي الكريم الحل كما يلي: نضع التاريخ الأول في خلية ما ثم في الخلية التالية الرقم الذي تريد جمعه أو طرحه ثم في الخلية التالية تضع = (خلية التاريخ-1) +أو - خلية الرقم المطلوب ينتج عندك تاريخ جديد هو حاصل جمع أو طرح خلية الرقم مع أو من (خلية التاريخ الأول-1) مع مراعاة عدد الأيام في كل شهر. أما -1 لكي لا يحسب يوم البدء مرتين. والله أعلم تقبل تحياتي والسلام عليكم

السلام عليكم ورحمة الله وبركاته أخي الكريم تكتب في الخلية A1 عنوان العمود مثلاً: الاسم وتكتب في الخلية B1 فاصلة من مفتاح و في لوحة المفاتيح ثم تكتب في الخلية C1 الرقم تكتب الأسماء أو تنسخها تحت عنوان الاسم وتسحب الفاصلة نزولاً حتى آخر اسم وتكتب الأرقام تحت عنوان الرقم يفضل أن تكون الأسماء بالإنكليزية تحفظ الملف بصيغة تقوم بتنزيل برنامج التحويل إلى vcd من الرابط التالي: تحويل من csv إلى vcd تفتح البرنامج من Browse تختار الملف الذي به قائمة الأسماء وأرقام الهواتف اختر من Properties مقابل الاسم Full Name ومقابل الرقم Mobile Phone ثم Convert ينتج عندك ملف جديد بنفس الاسم تنسخه إلى جوالك ثم تفتح جهات الاتصال وتستورد الأسماء من هذا الملف وبذلك تكون أنجزت هذا التحويل تقبل تحياتي العطرة والسلام عليكم.

شكرا للاستاذ نزار و شكرا جزيلا للاستاذ محمد حسن الشرح وافى جدا وحلت مشكلتى لكم جميعا جزيل الشكر

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

تحتاج لهذه المعادله =(IF(LEFT(C6,1)="3","السنة الثالثة",IF(LEFT(C6,1)="2","السنة الثانية","السنة الاولى"))) انظر للمرفق مستوى.xlsx

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

اضافة لاستاذ موسى واثراء للموضوع ..يمكن استخدام الجملة التالية: LastValue :Mid([Daignosis];InStrRev([Daignosis];",")+1) وان كان هناك فراغ بين الكلمات تستخدم LastValue :Mid([Daignosis];InStrRev([Daignosis];" ")+1)

تمام عليك استاذ احمد .. طبعا ستعمل حسب رغبة المستخدم هل يريد زر واحد او اكثر انظر هنا عملت حسب رغبتي انا وهي ان تتم مجموعة خيارات من خلال زر واحد بمعنى ان تركت الحقول خالية سوف يظهر الكل وان اخترت تاريخين يفلتر ما بين التاريخين وان اخترت اسم طالب يفلتر حسب اسم الطالب بناء على التواريخ وان ازلت التواريخ يظهر جميع غيابات الطالب المحدد اخي الكريم ابو اياد انا اختلف عن باقي احبتي وزملائي هنا .. فأنا ادرس اساسات البرمجة ولا اكتفي بحل المشكلة فقط لذا ستجد مثالك تم تعديله الى ما يجب ان يكون عليه فلو بقيت على وضعك الحالي باستخدام الحروف العربية فستتعب كثيرا ولن تتعلم وستكون عقدتك الاساسية هي الاكواد وفهمها وكتابتها .. ولن تجد المتعة التي يجدها غيرك .. غياب_مهذب.rar

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

اذا كان الحقل فارغا فأن دالة Nz تعيد اليك القيمة بصفر حتى لا يحصل عندك خطأ

السلام عليكم ورحمة الله تعالى وبركاته من حين لآخر قد نستخدم برامج محمولة بتمرير قيم اليها لاجراء بعض العمليات من خلال الـ Command Line ولكن احيانا تعلق بالذاكرة ولا يتم إغلاق البرامج بشكل صحيح وبالتالي تسبب الصداع والمشاكل التى تجعلك غير قادر على معاودة العمل مرة أخرى لذلك قد يصبح من الضروري إنهاء العملية بالقوة بقتل التطبيق العالق فى الذاكرة اقدم لكم وظيفة بسيطة تقوم بتمرير الاسم الكامل للعملية المطلوب إنهاؤها فقط Public Function WMI_KillProcess(sProcessName As String, Optional sHost As String = ".") As Boolean On Error GoTo Error_Handler Dim oWMI As Object 'WMI object to query about the PC's OS Dim sWMIQuery As String 'WMI Query Dim oCols As Object Dim oCol As Object Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2") sWMIQuery = "SELECT Name FROM Win32_Process" Set oCols = oWMI.ExecQuery(sWMIQuery) For Each oCol In oCols If LCase(sProcessName) = LCase(oCol.Name) Then oCol.Terminate ' Kill this instances of the process End If Next oCol WMI_KillProcess = True Error_Handler_Exit: On Error Resume Next Set oCol = Nothing Set oCols = Nothing Set oWMI = Nothing Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: WMI_KillProcess" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function ويتم استدعاء الوظيفة من خلال السطر الاتى Call WMI_KillProcess("calculator.exe") طبعا تغير اسم التطبيق العالق والذى تريد انهاءه بالقوة بدلا من calculator.exe وهذا مثال للتوضيح KillProcess.accdb

السلام عليكم 🙂 اسمح لي ارد على هذا الاقتراح ، وبالتفصيل ، فنيا ، وبالتجربة : 1. انا اعتبر تصفح ملف pdf الذي به صور ، كأني اتصفح ملف الموظف الورقي ، لا يمكنني البحث فيه ، فأقلبه صورة صورة ، حتى اصل الى الصورة اللي اريدها ، واذا اريد مقارنة/النظر في صورة اخرى ، فأتصفح زيادة الى ان اصل الى الصورة الثانية ، وهنا لا استطيع مقارنة هذه الصورة بالصورة السابقة!! يمكن استعمال ملف pdf في حال: انك لن تبحث عن صورة/رسالة/كتاب/شهادة معينة ، اي انك لا تحتاج الوصول الى صورة معينة من الملف ، وفي حال: انك لن تحتاج الى اضافة صورة جديدة وسط محتواه ، 2. ملف pdf يحتفظ بالصور بصيغة مضغوطة ، وهذه الصيغة تعتمد على نوع بيانات الصورة ، وهذا الضغط هو الذي يقلل من حجم ملف pdf ، مثلا انظر في مواصفات هذا البرنامج الذي يحفظ الصور في ملف pdf : . او حتى لما تريد تصدر التقرير بصيغة pdf ، عندك خيار الضغط (ولكن بطريقة اخرى) : . الضغط على الصورة يجعلها تفقد بعض وضوحها ، وخصوصا اذا كان الضغط كبير (حتى تصبح الصورة صغيرة) ، وتتجه المؤسسات الى الاعتماد على هذه المستندات للارشفة ، مع التخلص من الاوراق الاصليه (بعد مدة من الزمن) ، هناك ISO خاص لأرشفة الصور ، وفيها يجب ان تكون دقة الصور 300 ، 600 (الموصى به) ، او 2100 DPI ، والنقاوة يجب ان تكون اقصاها او اقل بقليل (يعني بدون ضغط او ضغط قليل) ، وصار مع احد المؤسسات التي اتعامل معها ، اشتروا سكانر جديد واستعملوه مباشرة وبدون ضبط اعداداته ، وتم استعماله في ارشفة الوثائق ، وبعد مدة طُلب منهم التحقق في الاسم الرابع لأحد الموظفين , كانت وثيقته بخط اليد ، ولم يتمكنوا من التأكد اذا كان الاسم تامر او ثامر ، بسبب ان دقة الصورة كانت صغيرة والضغط كبير ، فاضطروا لطلب نسخة ورقية اخرى من الموظف (كانت فترة الابقاء على النسخة الورقية للملف قد انتهت وتم تلفها). . 3. نعم اسهل في عمل ملف pdf واحد من السكانر يحتوي على مجموعة وثائق ، ولكن هناك صعوبة للوصول الى الوثيقة المطلوبة ، وبسرعة في ملف pdf (انظر ملاحظتي اعلاه) ، بينما الطريقة التي اتبعتها لبرنامج شؤون الموظفين ، هو نسخ الوثائق وحفظها صورة صورة بصيغة jpg ، برقم مسلسل ، والبرنامج لما يفتح النموذج الخاص بالموظف ، فتلقائيا النموذج يبحث في مجلد الموظف عن جميع الوثائق الموجودة ، وعليه نرى مثل هذه الواجهة : و فمسمى الحقل يتحول لونه الى اللون الازرق الفاتح اذا كانت هناك وثيقة/وثائق تخص هذا الحقل ، وعند النقر على المسمى ، تظهر لنا جميع الوثائق التي تخص هذا الحقل فقط : . (وهنا تجد نسخه من النموذج اعلاه لتصفح الصور : https://www.officena.net/ib/topic/84228-هدية-العيد-استعراض-صورصورة-بأحجام-مختلفة/ ) وهذا لا يمكن عمله مع ملف pdf ، فإذن استخدام ملف pdf ليس اسهل للوضول الى المعلومة مباشرة . 4. وحتى اسهل عليك ، اليك الدالة التي عملتها ، لتعمل اسم الملف بالتسلسل : Public Function Biggest_Value_in_Folder(ByVal Fldr As String, Pttrn As String, Digts As Integer, fle_Type As String) 'usage: 'Call Biggest_Value_in_Folder("D:\Temp", "EM_New_Section_Letter_Number_", 6, "jpg") Dim strFile As String If Len(fle_Type & "") = 0 Then fle_Type = "*" strFile = Dir(Fldr & "\" & Pttrn & "*." & fle_Type) 'Debug.Print strFile Do Until strFile = "" 'NumberOfFiles = NumberOfFiles + 1 If Val(right(strFile, Digts)) > Biggest_Value_in_Folder Then Biggest_Value_in_Folder = Val(right(strFile, Digts)) End If strFile = Dir() Loop End Function . وهكذا استعملها . 'the folder path newpathANDname = BE_Path & "\Scanned_Files\" & Me.Employee_ID 'if the Employee_ID Dir dose not exist, creat it If Dir(newpathANDname, vbDirectory) = "" Then MkDir newpathANDname End If 'get the Biggest Seq io this file type Biggest_Value = Biggest_Value_in_Folder(newpathANDname, "EM_New_Section_Letter_Number_", 6, "jpg") newpathANDname = newpathANDname & "\" & "EM_New_Section_Letter_Number_" x = Split(Me.Selected_Files, vbCrLf) For j = LBound(x) To UBound(x) If Len(x(j)) <> 0 Then 'existing jpg file path and name oldpathANDname = x(j) NumberOfFiles = NumberOfFiles + 1 Biggest_Value = Biggest_Value + 1 'copy the jpg file to the correct directory FileCopy oldpathANDname, newpathANDname & Format(Biggest_Value, "000000") & ".jpg" End If 'Len(x(j)) <> 0 Next j . جعفر

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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته تحياتي إلى الجميع تكملة شرح UserForm Spreadsheet قبل عمل ال TextBox لنستخدمه في البحث او الفلترة سنقوم بعمل بعض التحابيش الجماليه لل Spreadsheet وهي اخفاء لبعض الاشرطه والادوات من ال Spreadsheet لتبدو لنا مثل ListBox تماما كما في الصوره التاليه سيتم اخفاء كل الاشرطة والادوات التي تم تميزها باللون الاحمر ويتم ذلك بأستخدام اجراء تنشيط UserForm وهو UserForm_Activate وتكون الاكواد كالاتي ================================================== Private Sub UserForm_Activate() ' '================================================================== With Spread .DisplayToolbar = False ' اخفاء شريط الادوات With .ActiveWindow .DisplayWorkbookTabs = False ' اخفاء تاب اوراق العمل .EnableResize = False ' اخفاء تاب التحكم في حجم ورقة العمل .DisplayHeadings = False ' اخفاء ترقيم الصفوف و الاعمدة .DisplayHorizontalScrollBar = False 'اخفاء شريط التمرير الافقي .DisplayVerticalScrollBar = False 'اخفاء شريط التمرير الرأاسي End With End With '================================================================== ' End Sub ================================================== والان نكمل المثال بعد تم عرض كامل الدتا داخل Spread 1 - سنقوم بعمل زر للخروج طور الفورم 2 - سنعمل عدد 2 TextBox احدهما للبحث او الفلترة والثاني لمجموع مبالغ المكافئة 3 - سنعمل عدد 2 OptionButton الاول للفلترة من بداية الاسم والثاني للفلترة بأي جزء من الاسم وتكون الاكواد كالاتي في حدث TextBox1_Change كالاتي عند ادراج اى حرف في TextBox1 يبدأ تنشيط هذا الحدث ================================================== Private Sub TextBox1_Change() ' On Error GoTo End_Me Spread.Rows("1:" & Rows.Count).ClearContents 'حذف محتويات ال Spread بالكامل ' '/============================================================= Search_Text = TextBox1 & "*" 'في حالة تنشيظ ال OptionButton1 'توجيه محتوي ال TextBox1 الى المتغير Search_Text 'واضافة علامة النجمة له في نهايته ليكون البحث او الفلترة بجزء من بداية الاسم If OptionButton2 Then Search_Text = "*" & TextBox1 & "*" ' اما في حالة تنشيظ ال OptionButton2 'توجيه محتوي ال TextBox1 الى المتغير Search_Text 'واضافة علامة النجمة له في البداية و النهايته ليكون البحث او الفلترة بأي بجزء من الاسم ScreenOn Sh_Data.Range("A1").AutoFilter Field:=2, Criteria1:=Search_Text 'في ورقة العمل الرئيسية عمل تصفية تلقائية على العمود الثاني (الاسم) 'بمحتوي متغير الفلترة المتغير Search_Text '/============================================================= Sh_Data.AutoFilter.Range.Copy 'بعد الفلترة نسخ ناتج الفلترة من ورقة العمل الرئيسية الي الذاكرة With Spread With .Range("A1") .Paste 'لصق ناتج الفلترة الي ال Spread .Select End With End With '/============================================================= Total = Sh_Data.Range("M1").Value TextBox2 = CStr(Format(Total, "0.00")) 'نسج خلية المجموع ( M1 ) من ورقة العمل الرئيسية الي TextBox2 في الفورم '/============================================================= End_Me: ScreenOn On Error GoTo 0 ' End Sub ================================================== ملحوظة بعد عمل الفلترة على الفورم يمكن التبديل بين بداية الاسم و أي جزء الاسم الملف موجود بالمرفقات_6 تم تجربة المثال علي كل من أوفيس 11 / 2003 و أوفيس 14 / 2010 بدون أي مشاكل وبذلك ينتهي شرح UserForm Spreadsheet والي لقاء قريب بإذن الله مع شرح اداة ثانية نادرة الاستخدام مغمورة مطمورة ================================================== المرفقات_6.rar تحياتى لكم جميعا

السلام عليكم ورحمة الله وبركاته الحمد لله على عودة الموقع من جديد نكمل معكم ان شاء الله ما بدأناه فىى هذا الموضوع وهو طريقة انشاء شريط ادوات بواسطة Xml وقد تعلمنا كيفية اضافة تبويب Tab جديد وكيفية اضافة المجموعات Groups الى التبويب Tab واليوم ان شاء الله نتعلم كيفية اضافة الادوات كالازار وغيرها الى التبويب كان هذا هو الكود الذى وصلنا اليه فى نهاية الموضوع السابق <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <ribbon startFromScratch="false"> <tabs> <tab id="customTb" label="MY NEW TAB" visible="true"> <group id="dbGroup" label="’My Group"> </group> </tab> </tabs> </ribbon> </customUI> وهو يقوم بانشاء تبويب جديد واضافة مجموعة جديدة بداخله وكما لاحظنا فان جميع الوسمة متداخله ف ribbon بداخلها Tab ثم Group واخيرا بداخله الاوسمة الخاصة بالادوات عندما نقوم باضافة ادوات نعرف الاداة كما يلى <سمات الاداة معرف الاداة اسم الاداة/> اسم الاداة هو تحديد اذا كانت زر او خانة اختيار او قائمة منسدلة وغيرها ثم معرف الاداة وينقسم معرف الاداة الى قسمين اما معرف مايكروسوفت اوفيس او معرف خاص فالمعرف الخاص بالاوفيس هو الادوات الموجودة فى الاوفيس اصلا كالنسخ واللصق والمحاذاة وغيرها اما ان اردنا انشاء اداة خاصة بنا نستخدم معرف خاص نختاره كيفما نشاء ثم سمات الاداة وهى باختصار تشبه خصائص الاداة كالحجم والتسمية التوضيحية والصورة وغيرها وهذه اكثرها استخداما Enabled تستخدم لمعظم الادوات Visible اظهار او عدم اظهار ID/IDMso المعرف الخاص بالعنصر Image/ImageMso الصورة الخاصة بالعنصر InsertAfterMso لتحديد مكان العنصر بعد عنصر آخر InsertBeforeMso لتحديد مكانه قبل عنصر آخر Lable التسمية التوضيحية Size الحجم والآن بعد هذا الطلاع على طريقة تعريف الاداة بشكل عام دعونا نعرف تفاصيل اكثر بالتطبيق العملى <button idMso="Cut" label="My Cut Button"/> هذا هو كود انشاء زر قص Cut وكما قلت سابقا اسم الاداة button وبعد ذلك المعرف وهنا استخدمنا المعرف الخاص بالاوفيس Cut ونستخدم هذه الطريقة عندما نريد ادراج اى من الادوات الموجودة بالاوفيس والاكسيس ولمعرفة المعرف الخاص باى اداة مثلا التصدير لاكسيل افضل طريقة هى كما بالصورة نجد ان المعرف مكتوب بين قوسين وهو فى هذه الحالة ExportExcel ويجب الانتباه لحالة الاحرف <button idMso="ExportExcel" label="Export To Excel By XML" /> وكما قلنا سابقا ان هناك العديد من الخصائص او السمات التى نقوم بتمريرها للعنصر وجيمعها اختيارى ما عدا ال ID فاذا ادخلنا مثلا الكود بهذه الطريقة دون تحديد خاصية Size لهذا الزر نلاحظ ظهوره بالشكل الافتراضى الصغير وكذلك صورة الامر Cut الافتراضية وهو هكذا اذا اردنا ان تجعل حجمه يظهر بشكل كبير علينا ان نقوم باضافة السمة Size الى الكود ليصبح بهذا الشكل والخاصية size= اما normal كما فى الصورة السابقة او large كما فى الصورة التالية <button idMso="Cut" label="My Cut Button" Size="large" /> وكذلك الخاصية Enabled <button idMso="Cut" label="My Cut Button" Size="large" enabled="false" /> واذا اردنا تغيير خاصبة Visible اخفاءالامر cut نكتب كما يلى <button idMso="Cut" visible="false" /> اما الخاصية InsertBeforeMso و insertAfterMso فتكون كالتالى <button idMso="ExportExcel" label="Export For EXC" size="large" insertBeforeMso="Cut" /> فهذا الكود يقوم بانشاء زر التصدير لاكسيل ويضعه قبل الامر Cut الذى انشاناه سابقا وان اردنا ان يضعه بعده فنغير InsertBeforeMso الى insertAfterMso وهكذا اعتقد اننا قد انتهينا من شرح اهم الخصائص فى الازرار وكيفية استخدامها وكيفية انشاء زر يقوم بمهمة مضمنة فى الاوفيس اما بالنسبة لعمل زر يقوم بتنفيذ امر مايكرو فيكون الكود هكذا <button id="Msg" label="Hello" Size="large onAction="اسم الماكرو" /> و onAction هو عبارة عن سمة نكتب بها ما يحدث عند التفاعل مع الاداة كالضغط على الزر فى هذه الحالة ويصبح الكود النهائى حتى الآن <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <ribbon startFromScratch="false"> <tabs> <tab id="customTb" label="MY NEW TAB" visible="true"> <group id="dbGroup" label="’My Group"> <button idMso="Cut" label="Cut" size="large" /> <button idMso="ExportExcel" label="Export For EXC" size="large" insertBeforeMso="Cut" /> <button id="RunMacro" label="Open" size="large" imageMso="ViewsFormView" onAction="OpenForm"/> </group> </tab> </tabs> </ribbon> </customUI> وان شاء الله فى الدرس القادم نتحدث عن ربط الازرار بالماكرو والكود بتفصيل اكثر مرفق لكم القاعدة وبها ما شرحته Ribbon Customizations.rar

شكرا لك اخي ابا جودي على النصيحه المشكله ان القاعده حجمها اكثر من ١ جيجا