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

المهم انت عندك .. ده كفاية وانت من جواك عارف ومتيقن انى لو عاوز اعمل زيها بفضل الله سبحانه وتعالى هقدر 😉 ... برضو ده عندى كفاية 😛

اعرض الملف لعشاق كرة القدم (ملف أكسل لإحتساب نتائج كأس العالم 2026) رغم أني لا أنشط إلا في منتدى أكسس إلا أني اليوم قررت أن أرفق لكم ملف أكسل جميل كان قد أرسله لي شقيقي الأصغر هشام بعد أن وجده في أحد المواقع الأجنبيه وقام بتعريبه ووضع بعض التحسينات عليه وقد إستأذنته في رفعه إلى المنتدى ووافق بكل سرور كل ما عليكم هو إدخال النتائج في الورقة Match Results وسيقوم أكسل ببقية العمل أرجو أن ينال العمل إستحسانكم وإذا كان هناك أي ملاحظات فلا تتردوا في ذكرها تحياتي صاحب الملف منتصر الانسي تمت الاضافه 04/11/26 الاقسام قسم الإكسيل

احد اكثر مشاكل الخلط بين الفاصلة والفاصلة المنقوطة ، هي عند عمل ملف csv ، وترى انه لا يفتح عند العميل !! الامثلة التالية لعمل هذا الملف بأربعة طرق مختلفة ، وترى نتيجة الطرق في صورة من ملفات الاكسل ادناه: 3 طرق عن طريق الامر #Print بإستعمال: الفاصلة Comma ، الفاصلة المنقوطة Semi Comma ، فاصل النظام عن طريق الدالة fList_Seperator (في الكود اعلاه). ومرة عن طريق الامر #Write والذي لا يحتاج الى فواصل Function make_csv_1() Dim file_path As String Dim i As Integer ' , file_path = CurrentProject.Path & "\csv_COMMA.csv" Open file_path For Output As #1 Print #1, "AscW" & "," & "الحرف" For i = 1575 To 1610 Print #1, i & "," & ChrW(i) Next i Close #1 ' ; file_path = CurrentProject.Path & "\csv_Semi_COMMA.csv" Open file_path For Output As #1 Print #1, "AscW" & ";" & "الحرف" For i = 1575 To 1610 Print #1, i & ";" & ChrW(i) Next i Close #1 ' Line Seperator file_path = CurrentProject.Path & "\csv_Separator.csv" Open file_path For Output As #1 Print #1, "AscW" & fList_Seperator & "الحرف" For i = 1575 To 1610 Print #1, i & fList_Seperator & ChrW(i) Next i Close #1 ' Write file_path = CurrentProject.Path & "\csv_Write.csv" Open file_path For Output As #1 Write #1, "AscW", "الحرف" For i = 1575 To 1610 Write #1, i, ChrW(i) Next i Close #1 End Function . . رجاء الانتباه ان نظام حاسبتي انجليزي وليس عربي ، لذلك فنتائجي قد تختلف عن نتائجك

مشاركة مع اساتذتي تفضل استاذ @بلال بلال مرفقك بعد التعديل . ووافني بالرد . البرنامج.rar

استاذ ممكن عمل نموذج بارك الله فيك

أخواني وأساتذتي ومعلمينا ( دون استثناء ) يتوفر نظام متكامل للتفعيل من خلال الإنترنت بالمميزات التالية :- نظام بصمة لكل جهاز فريد وغير متكرر . التفعيل من خلال البريد الإلكتروني + بصمة الجهاز . سيرفر يسجل جميع النسخ التي تم تشغيلها لبرنامجك . رمز Pin لتأكيد التفعيل بالبريد الإلكتروني بمدة محددة = 5 دقائق ، عند التفعيل لأول مرة فقط . إمكانية استرجاع التفعيل لنسخة العميل حتى بعد الفرومات وتغيير الجهاز . دعم متكامل للشركات التي تستخدم برنامجك على أكثر من جهاز . فيمكن استعمال رمز التفعيل على عدد تقرره وتحدده انت يصل لـ 100 جهاز على سبيل المثال ليقوم بالتفعيل من خلال رمز تفعيل واحد . دعم التفعيل المرن بمدة حسب الحاجة ( شهر ، 3 شهور ، 6 شهور ، سنة ، مدى الحياة ، مدة محددة على سبيل المثال 40 يوماً ) . دعم إمكانية حجب نسخة عميل من التفعيل واستخدام البرنامج . دعم الإقفال عند التلاعب بالوقت والتاريخ مضبوط بشكل محكم 101% . واجهة للمطور مخصصة بالتفعيل عن بعد . أو بإرسال رقم التفعيل للعميل لاستخدامه بشكل يدوي . سيرفر مدعوم من جوجل مجاني يصل لـ 15 جيجا كحجم بيانات . دعم الصيانة على الأداة المخصصة بالتفعيل 6 شهور بعد البيع . نسخة تجريبية يمكن التحكم بها - الإفتراضية 7 أيام . للتواصل من خلال الواتس أب :- 00962787818180

وحقا عمل جميل ورائع ونتمنى نتمنى منك عندما ينتهي البرنامج ياريت ترفعه مفتوح المصدر لكي نستفيد من خبراتك

يمكن وضعه كنموذج فرعى داخل اى نموذج وسوف يعمل على الفور بدون ادنى تدخل الاكواد التى تمت كتابتها لهذا العمل Option Compare Database Option Explicit Private mHostForm As Access.Form Private mRecordCount As Long Private mIsInitialized As Boolean Private mLastPosition As Long Private mLastCount As Long Private mLastIsNew As Boolean Private mHasLastState As Boolean Private Sub Form_Load() InitializeNavigator End Sub Private Sub InitializeNavigator() If Not EnsureHostForm Then Exit Sub RefreshRecordCount True With mHostForm.Recordset If Not (.BOF And .EOF) Then .MoveFirst End With UpdateUI mIsInitialized = True End Sub Private Sub Form_Current() If mIsInitialized Then UpdateUI End Sub Private Function EnsureHostForm() As Boolean On Error GoTo ErrorHandler If mHostForm Is Nothing Then If TypeOf Me.Parent Is Form Then Set mHostForm = Me.Parent End If ExitFunction: EnsureHostForm = Not (mHostForm Is Nothing) Exit Function ErrorHandler: Set mHostForm = Nothing Resume ExitFunction End Function Private Function HasRecords() As Boolean HasRecords = (mRecordCount > 0) End Function Private Sub RefreshRecordCount(Optional ByVal force As Boolean = False) On Error GoTo ErrorHandler If Not EnsureHostForm Then mRecordCount = 0 Exit Sub End If If Not force Then If mRecordCount > 0 Then Exit Sub End If With mHostForm.RecordsetClone If .BOF And .EOF Then mRecordCount = 0 Else .MoveLast mRecordCount = .recordCount End If End With ErrorHandler: End Sub Private Function GetCurrentPosition() As Long On Error GoTo ErrorHandler If Not EnsureHostForm Then GetCurrentPosition = 0 ElseIf mRecordCount <= 0 Then GetCurrentPosition = 0 ElseIf mHostForm.NewRecord Then GetCurrentPosition = mRecordCount + 1 Else Dim pos As Long pos = mHostForm.CurrentRecord If pos <= 0 Then pos = 1 GetCurrentPosition = pos End If Exit Function ErrorHandler: GetCurrentPosition = 0 End Function Private Sub UpdateUI() On Error GoTo SafeExit Dim frm As Form Dim currentPosition As Long Dim isEmpty As Boolean Dim isNew As Boolean Dim isFirst As Boolean Dim isLast As Boolean If Not EnsureHostForm Then If Not mHasLastState _ Or mLastPosition <> 0 _ Or mLastCount <> 0 _ Or mLastIsNew <> False Then Me.lblRecordPosition.Caption = "0 of 0" Me.cmdGoFirst.Enabled = False Me.cmdGoPrevious.Enabled = False Me.cmdGoNext.Enabled = False Me.cmdGoLast.Enabled = False Me.cmdDeleteCurrent.Enabled = False mLastPosition = 0 mLastCount = 0 mLastIsNew = False mHasLastState = True End If Exit Sub End If Set frm = mHostForm currentPosition = GetCurrentPosition() isEmpty = (mRecordCount <= 0) isNew = frm.NewRecord If mHasLastState Then If mLastPosition = currentPosition _ And mLastCount = mRecordCount _ And mLastIsNew = isNew Then Exit Sub End If If isEmpty Then Me.lblRecordPosition.Caption = "0 of 0" Else Me.lblRecordPosition.Caption = currentPosition & " of " & mRecordCount End If isFirst = (currentPosition <= 1 And Not isNew) isLast = (currentPosition >= mRecordCount And Not isNew) Me.cmdGoFirst.Enabled = Not isEmpty And Not isFirst Me.cmdGoPrevious.Enabled = Not isEmpty And Not isFirst Me.cmdGoNext.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdGoLast.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdDeleteCurrent.Enabled = Not isEmpty And Not isNew mLastPosition = currentPosition mLastCount = mRecordCount mLastIsNew = isNew mHasLastState = True Exit Sub SafeExit: Debug.Print "UpdateUI Error: "; Err.Number; " - "; Err.Description End Sub Private Sub cmdGoFirst_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveFirst mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoPrevious_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then cmdGoLast_Click Exit Sub End If On Error GoTo ErrorHandler With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark If mHostForm.CurrentRecord > 1 Then .MovePrevious mHostForm.Bookmark = .Bookmark End If End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoNext_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub On Error GoTo ErrorHandler If mHostForm.CurrentRecord >= mRecordCount Then UpdateUI Exit Sub End If With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark .MoveNext If Not .EOF Then mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoLast_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveLast mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdCreateNew_Click() On Error GoTo ErrorHandler If Not EnsureHostForm Then Exit Sub mHostForm.SetFocus DoCmd.GoToRecord acDataForm, mHostForm.name, acNewRec RefreshRecordCount True UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdDeleteCurrent_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub If MsgBox("هل تريد حذف السجل الحالي نهائيًا؟", vbYesNo + vbQuestion + vbDefaultButton2, "تأكيد الحذف") <> vbYes Then Exit Sub On Error GoTo ErrorHandler Dim rsClone As DAO.Recordset Dim bm As Variant Dim nextBM As Variant Set rsClone = mHostForm.RecordsetClone bm = mHostForm.Bookmark rsClone.Bookmark = bm rsClone.MoveNext If rsClone.EOF Then rsClone.Bookmark = bm rsClone.MovePrevious If rsClone.BOF Then nextBM = Null Else nextBM = rsClone.Bookmark End If Else nextBM = rsClone.Bookmark End If If mHostForm.Dirty Then mHostForm.Dirty = False End If mHostForm.Recordset.Delete RefreshRecordCount True If IsNull(nextBM) Then mHostForm.SetFocus DoCmd.GoToRecord , , acNewRec Else mHostForm.Bookmark = nextBM End If rsClone.Close Set rsClone = Nothing UpdateUI Exit Sub ErrorHandler: On Error Resume Next If Not rsClone Is Nothing Then rsClone.Close Set rsClone = Nothing End If HandleNavigatorError Err.Number, Err.Description End Sub Private Sub HandleNavigatorError(ByVal errorNumber As Long, ByVal errorDescription As String) Select Case errorNumber Case 0, 3021 Exit Sub Case Else MsgBox "حدث خطأ رقم " & errorNumber & vbCrLf & errorDescription, vbExclamation, "خطأ في أداة التنقل" End Select End Sub Navigator.accdb

اعرض الملف أداة إنشاء المخططات البيانية المخصصة {سلسلة الأدوات المساعدة المخصصة} اقدم لكم اليوم هذه الأداة البسيطة في تصميمها والرائعة في نتائجها في القيام بتمثيل البيانات بمخططات بيانية لإنشاء تقارير رسومية الحقيقة أن هذه الأداة ليست بكفاءة عنصر التحكم Chart ولكنها تؤدي أغلب النتائج المطلوبة في المخططات البيانية البسيطة التي على شكل أعمدة أو خطوط ولا تتطلب أي مهارات للعمل بها قمت بإرفاق ملف أكسس يحتوي على كل ما ستحتاجونه لفهم الأداة وطريقة إستخدامها والإستفادة منها في تطبيقاتكم أرجو أن تنال إستحسانكم وفي إنتظار أي ملاحظات أو أخطاء قد يجدها البعض تحياتي صاحب الملف منتصر الانسي تمت الاضافه 04/11/26 الاقسام قسم الأكسيس  

،، جرب اجعل المعادلات في :- J2 = =IFERROR(IF(INDEX(Q:Q, MATCH(B5, P:P, 0)) = H2, "P", ""), "") J3 = =IFERROR(IF(INDEX(Q:Q, MATCH(B5, P:P, 0)) = H3, "P", ""), "") J4 = =IFERROR(IF(INDEX(Q:Q, MATCH(B5, P:P, 0)) = H4, "P", ""), "") وعدل الخلية B5 لتصبح :- =IFERROR(IF(MATCH(INDEX(data!$P$2:$P$23, MATCH($E$1, data!$R$2:$R$23, 0)), $P$2:$P$13, 0), INDEX(data!$P$2:$P$23, MATCH($E$1, data!$R$2:$R$23, 0)), ""), "") لتلافي الخروج عن نطاق P2 - P13

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

تفضل الملف حساب الفئة العمرية2.xlsx

وعليكم السلام ورحمة الله وبركاته .. لم يظهر أي مشكلة عند فتح المرفق وتعديل الأكواد لتعمل مع إصداري 64 .. ولكن في الإصدار 32 ، ظهرت المشكلة والسبب المعامل الثالث الذي يمرر في استدعاء الـ InpuBoxDK ، عدله ليصبح كالتالي :- str_Title = "سبحان الله وبحمده سبحان الله العظيم" strAdminPWord = InputBoxDK("Password required to proceed.", str_Title) بدلاً من :- str_Title = "سبحان الله وبحمده سبحان الله العظيم" strAdminPWord = InputBoxDK("Password required to proceed.", str_Title, "Enter Licence Code")

في المثال الذي ارفقته ، يمكنك الحصول على اي بيانات من الاعدادات الاقليمية ، فهناك بعض الامثلة على ذلك. هذا الكود كاملا من المرفق: Option Compare Database Option Explicit ' This code was originally written by Dev Ashish. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Dev Ashish ' Public Const LOCALE_ILANGUAGE = &H1 ' language id Public Const LOCALE_SLANGUAGE = &H2 ' localized name of language Public Const LOCALE_SENGLANGUAGE = &H1001 ' English name of language Public Const LOCALE_SABBREVLANGNAME = &H3 ' abbreviated language name Public Const LOCALE_SNATIVELANGNAME = &H4 ' native name of language Public Const LOCALE_ICOUNTRY = &H5 ' country code Public Const LOCALE_SCOUNTRY = &H6 ' localized name of country Public Const LOCALE_SENGCOUNTRY = &H1002 ' English name of country Public Const LOCALE_SABBREVCTRYNAME = &H7 ' abbreviated country name Public Const LOCALE_SNATIVECTRYNAME = &H8 ' native name of country Public Const LOCALE_IDEFAULTLANGUAGE = &H9 ' default language id Public Const LOCALE_IDEFAULTCOUNTRY = &HA ' default country code Public Const LOCALE_IDEFAULTCODEPAGE = &HB ' default code page Public Const LOCALE_SLIST = &HC ' list item separator Public Const LOCALE_IMEASURE = &HD ' 0 = metric, 1 = US Public Const LOCALE_SDECIMAL = &HE ' decimal separator Public Const LOCALE_STHOUSAND = &HF ' thousand separator Public Const LOCALE_SGROUPING = &H10 ' digit grouping Public Const LOCALE_IDIGITS = &H11 ' number of fractional digits Public Const LOCALE_ILZERO = &H12 ' leading zeros for decimal Public Const LOCALE_SNATIVEDIGITS = &H13 ' native ascii 0-9 Public Const LOCALE_SCURRENCY = &H14 ' local monetary symbol Public Const LOCALE_SINTLSYMBOL = &H15 ' intl monetary symbol Public Const LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator Public Const LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator Public Const LOCALE_SMONGROUPING = &H18 ' monetary grouping Public Const LOCALE_ICURRDIGITS = &H19 ' # local monetary digits Public Const LOCALE_IINTLCURRDIGITS = &H1A ' # intl monetary digits Public Const LOCALE_ICURRENCY = &H1B ' positive currency mode Public Const LOCALE_INEGCURR = &H1C ' negative currency mode Public Const LOCALE_SDATE = &H1D ' date separator Public Const LOCALE_STIME = &H1E ' time separator Public Const LOCALE_SSHORTDATE = &H1F ' short date format string Public Const LOCALE_SLONGDATE = &H20 ' long date format string Public Const LOCALE_STIMEFORMAT = &H1003 ' time format string Public Const LOCALE_IDATE = &H21 ' short date format ordering Public Const LOCALE_ILDATE = &H22 ' long date format ordering Public Const LOCALE_ITIME = &H23 ' time format specifier Public Const LOCALE_ICENTURY = &H24 ' century format specifier Public Const LOCALE_ITLZERO = &H25 ' leading zeros in time field Public Const LOCALE_IDAYLZERO = &H26 ' leading zeros in day field Public Const LOCALE_IMONLZERO = &H27 ' leading zeros in month field Public Const LOCALE_S1159 = &H28 ' AM designator Public Const LOCALE_S2359 = &H29 ' PM designator Public Const LOCALE_SDAYNAME1 = &H2A ' long name for Monday Public Const LOCALE_SDAYNAME2 = &H2B ' long name for Tuesday Public Const LOCALE_SDAYNAME3 = &H2C ' long name for Wednesday Public Const LOCALE_SDAYNAME4 = &H2D ' long name for Thursday Public Const LOCALE_SDAYNAME5 = &H2E ' long name for Friday Public Const LOCALE_SDAYNAME6 = &H2F ' long name for Saturday Public Const LOCALE_SDAYNAME7 = &H30 ' long name for Sunday Public Const LOCALE_SABBREVDAYNAME1 = &H31 ' abbreviated name for Monday Public Const LOCALE_SABBREVDAYNAME2 = &H32 ' abbreviated name for Tuesday Public Const LOCALE_SABBREVDAYNAME3 = &H33 ' abbreviated name for Wednesday Public Const LOCALE_SABBREVDAYNAME4 = &H34 ' abbreviated name for Thursday Public Const LOCALE_SABBREVDAYNAME5 = &H35 ' abbreviated name for Friday Public Const LOCALE_SABBREVDAYNAME6 = &H36 ' abbreviated name for Saturday Public Const LOCALE_SABBREVDAYNAME7 = &H37 ' abbreviated name for Sunday Public Const LOCALE_SMONTHNAME1 = &H38 ' long name for January Public Const LOCALE_SMONTHNAME2 = &H39 ' long name for February Public Const LOCALE_SMONTHNAME3 = &H3A ' long name for March Public Const LOCALE_SMONTHNAME4 = &H3B ' long name for April Public Const LOCALE_SMONTHNAME5 = &H3C ' long name for May Public Const LOCALE_SMONTHNAME6 = &H3D ' long name for June Public Const LOCALE_SMONTHNAME7 = &H3E ' long name for July Public Const LOCALE_SMONTHNAME8 = &H3F ' long name for August Public Const LOCALE_SMONTHNAME9 = &H40 ' long name for September Public Const LOCALE_SMONTHNAME10 = &H41 ' long name for October Public Const LOCALE_SMONTHNAME11 = &H42 ' long name for November Public Const LOCALE_SMONTHNAME12 = &H43 ' long name for December Public Const LOCALE_SABBREVMONTHNAME1 = &H44 ' abbreviated name for January Public Const LOCALE_SABBREVMONTHNAME2 = &H45 ' abbreviated name for February Public Const LOCALE_SABBREVMONTHNAME3 = &H46 ' abbreviated name for March Public Const LOCALE_SABBREVMONTHNAME4 = &H47 ' abbreviated name for April Public Const LOCALE_SABBREVMONTHNAME5 = &H48 ' abbreviated name for May Public Const LOCALE_SABBREVMONTHNAME6 = &H49 ' abbreviated name for June Public Const LOCALE_SABBREVMONTHNAME7 = &H4A ' abbreviated name for July Public Const LOCALE_SABBREVMONTHNAME8 = &H4B ' abbreviated name for August Public Const LOCALE_SABBREVMONTHNAME9 = &H4C ' abbreviated name for September Public Const LOCALE_SABBREVMONTHNAME10 = &H4D ' abbreviated name for October Public Const LOCALE_SABBREVMONTHNAME11 = &H4E ' abbreviated name for November Public Const LOCALE_SABBREVMONTHNAME12 = &H4F ' abbreviated name for December Public Const LOCALE_SABBREVMONTHNAME13 = &H100F Public Const LOCALE_SYSTEM_DEFAULT& = &H800 Public Const LOCALE_USER_DEFAULT& = &H400 Const cMAXLEN = 255 Private Declare PtrSafe Function apiGetLocaleInfo Lib "kernel32" _ Alias "GetLocaleInfoA" (ByVal Locale As Long, _ ByVal LCType As Long, ByVal lpLCData As String, _ ByVal cchData As Long) As Long '''' Function CountryName() As String Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngx As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngx = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCOUNTRY, strLCData, lngData) If lngx <> 0 Then CountryName = Left$(strLCData, lngx - 1) End If End Function '''' Function fLocaleInfo(lngLCType As Long) As String Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngx As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngx = apiGetLocaleInfo(LOCALE_USER_DEFAULT, lngLCType, _ strLCData, lngData) If lngx <> 0 Then fLocaleInfo = Left$(strLCData, lngx - 1) End If End Function Function fLOCALE_IMEASURE() As String ' 0 = metric, 1 = US Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngx As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngx = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, _ strLCData, lngData) If lngx <> 0 Then fLOCALE_IMEASURE = Left$(strLCData, lngx - 1) End If End Function Function fList_Seperator() As String ' list seperator , OR ; Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngx As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngx = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLIST, _ strLCData, lngData) If lngx <> 0 Then fList_Seperator = Left$(strLCData, lngx - 1) End If End Function وهذا مثال لا يوجد في المرفق: اذا اردنا عمل برنامج يعمل لجميع عملات العالم ، فيجب علينا وضع الفاصلة بالطريقة الصحيحة لكل دولة حسب الاعدادات الاقليمية لتلك الدولة: 1. فاصلة الآلاف (من الكود ، يتضح ان تعريفه هو: Public Const LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator ) 2. الفاصلة العُشرية (من الكود ، يتضح ان تعريفه هو:Public Const LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator ) : 1. طريقة اضافة فاصلة الآلاف (LOCALE_SMONTHOUSANDSEP ) : نأخذ نسخة من كود الفاصلة مثلا ، A - اسم الدالة ، B - قيمة فاصلة الآلاف اعلاه . فيصبح الكود: Function fmonetary_thousand_Seperator() As String ' monetary thousand separator Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngx As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngx = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONTHOUSANDSEP, _ strLCData, lngData) If lngx <> 0 Then fmonetary_thousand_Seperator = Left$(strLCData, lngx - 1) End If End Function Function fmonetary_decimal_Seperator() As String ' monetary decimal separator Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngx As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngx = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONDECIMALSEP, _ strLCData, lngData) If lngx <> 0 Then fmonetary_decimal_Seperator = Left$(strLCData, lngx - 1) End If End Function . وعندما نريد التأكد منها ، نتأكد هكذا: ?fmonetary_decimal_Seperator . ?fmonetary_thousand_Seperator , . ولكن الحمدلله ، لا نحتاج لعمل هذا في الاكسس ، فالامر التالي يقوم بالمهمة: ?format(12345.67,"Standard") 12,345.67

وعليكم السلام ورحمة الله تعالى وبركاته.. أفكار جميلة ، ومتطلبات قد تكون إضافات جميلة لمن يرغب بالمشاركة .. نتمنى أن تجد طلبك ومبتغاك هنا 🤗 .

جمعت الحلين في مثال واحد واضطررت لحذف كل الأكواد المتعلقة بحل الأستاذ عسل قليل الدسم مع الاعتذار لمزيد من التركيز للسائلة. تجربة صادر_05.accdb

حل آخر تجربة صادر_04.accdb

للتجربة .. الحل هو المظلل بالأصفر إن شاء الله. تجربة صادر_03.accdb

السلام عليكم .. للفائده بعد حل الموضوع وببساطه جدا ... 1ـ وضع حقل في جدول الوارد وتكون قيمته ترقيم تلقائي . 2ـ يتم عمل استعلام معتمد على جدول الوارد وجعل في فرز الترقيم التلقائي نجعله تنازلي . 3ـ نذهب الى الحقل المراد اظهار اخر قيمة فيه ( مربع نص ) ونستخدم الدالة او المعادلة التالية =DMax("[رقم الوارد]";"[اسم الاستعلام ]") وشكرا جزيلا لكل من الهمنا وشارك في حل الامر

هذه الجزئية مرهونة بإرفاقك الملف أخي الكريم 😉 . فالحلول كثيرة ولكنها تعتمد على بنيتك للجداول ونظامك بشكل عام ، وليس ما نفرضه عليك بمقترحاتنا 💐 .

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

شكراً لك ، ولكني لا أثق بالذكاء الإصطناعي ومقترحاته 😇 .

التطبيق فى قاعدتين الاولى : تجربة صادر الثانية : تجربة صادر-2 طبعا الاولى افضل واسرع وبدون اكواد للاسباب التالية أكثر سرعة : لا يوجد Query على قاعدة البيانات لان البيانات موجودة فى الذاكرة أكثر دقة : لأنها تضمن قراءة القيمة التي يتم إدخالها بشكل مباشر لذلك لن يحدث أي خطأ في التوقيت أكثر أمان : لأنها لا تعتمد على الدالة أو الترتيب في الجدول وبالتالي تقل احتمالية ظهور القيمة قبل الأخيرة أو Null متى يفضل إستخدام الطريقة التى تعتمد على الكود فى القاعدة الثانية عندما نريد الحصول على أخر قيمة فى زوايا التطبيق المختلفة اى فى نموذج أخر او فى استعلام أو فى اى مكان عندمل نريد دعم فلتر: يمكن إضافة شرط WHERE لاسترجاع اخر قيمة حسب معايير معينة أى الحصول على اخر رقم بشروط (مثلا حسب السنة) وهذا بالاخص ان كان يتم البدأ بالترقيم من الرقم 1 مرة أخرى سنويا ممكن نستخدمها بالشكل التالى: Me.Parent!txtLastIncoming = GetLastValue("رقم الوارد", "وارد", "Year([تاريخ الوارد]) = Year(Date())", 0) تجربة صادر.accdb تجربة صادر-2.accdb

كود ضعيف و يعتمد على الترتيب الفيزيائي في الجدول يعنى نفس مشكلة DLast غير ان بالشكل ده لو الجدول فارغ يحدث خطأ كمان : dbOpenTable بدون ترتيب وده لا يضمن الحصول على اخر قيمة الكود الصحيح يكون بالشكل التالى Function GetLastValue(ByVal strField As String, ByVal strTable As String, Optional ByVal strWhere As String = "", Optional ByVal vDefault As Variant = Null) As Variant On Error GoTo ErrHandler Dim rs As DAO.Recordset Dim strSQL As String strSQL = "SELECT TOP 1 [" & strField & "] FROM [" & strTable & "]" If strWhere <> "" Then strSQL = strSQL & " WHERE " & strWhere End If strSQL = strSQL & " ORDER BY [" & strField & "] DESC" Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot) If rs.EOF Then GetLastValue = vDefault Else GetLastValue = rs.Fields(0).Value End If CleanExit: If Not rs Is Nothing Then rs.Close Set rs = Nothing End If Exit Function ErrHandler: GetLastValue = vDefault Resume CleanExit End Function ويتم الاستخدام بالشكل التالى فى الحدث AfterInsert في النموذج الفرعي لانه يضمن تحديث القيمة فور اضافة وارد جديد Me.txtLastIncoming = GetLastValue("رقم الوارد", "وارد")

ليس بالضرورة إن كان الهدف الحصول على قيمة حقل محدد في آخر سجل ( شرط وجود حقل ترقيم مثلاً ) . ولكن إن كان ضمن شرط فعبارتك صحيحة 100% وهنا ممكن يستخدم حقل الترقيم كأساس على آخر قيمة . وممكن استعمال دالة بسيطة مثل :- Function GetLastValue(strField As String, strTable As String) As Variant Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset(strTable, dbOpenTable) rs.MoveLast GetLastValue = rs.Fields(strField).Value rs.Close End Function ويتم استدعائها في مربع نص غير منضم بتمرير اسم الجدول والحقل ، مثلاً :- =GetLastValue("رقم الوارد";"وارد")

اعرض الملف أداة إظهار الرسائل في منطقة الإشعارات {سلسلة الأدوات المساعدة المخصصة} أقدم لكم اليوم أداة جميلة ستجعل تطبيقاتكم تظهر بمظهر برامج ويندوز الأخرى وذلك لأنها تسمح لكم بإظهار رسائل التنبيه في منطقة الإشعارات كما بالصورة يتميز هذا النوع من الرسائل عن مربع الرسائل المعروف في أنها لا تكون منبثقة أمام بقية النماذج ولاتتسبب في إيقاف العمل لإغلاقها تشمل هذه الرسالة عنوان ونص وأيقونة كما بالصورة العمل بالأداة سهل جداً وكما يقولون بأن الصورة تعادل ألف كلمة فقد أرفقت معها صورة متحركة توضح طريقة العمل بها بالإضافة إلى بعض التعليمات الإضافية تجدونها داخل الملف المرفق والتي توضح الشروط الواجب توافرها حتى تعمل بنجاح وكيفية الإستفادة منها في تطبيقاتكم الخاصة أرجو أن تنال إعجابكم تحياتي صاحب الملف منتصر الانسي تمت الاضافه 03/22/26 الاقسام قسم الأكسيس  

رائع.......

السلام عليكم شكرا للمعلومات القيمه و الملف القيم الذي يتضمنها

اخي اذا امكن التواصل عبر الميل mohd_25_10@hotmail.com