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

تفضل اخي الكريم Root6.rar

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

وأياديك بيضاء أيضاً أستاذ جعفر.. لا عدمناك 🤑

السلام عليكم.. أرى أن حواراً ممتعا دار في هذه المشاركة مما أثار رغبتي في المشاركة.. 😀 أرجو أن تجدوا في هذه المشاركة شيئاً جديداً ومميزاً.. 🤩 سوف نتعامل مع مصنف أكسل كقاعدة بيانات ولعمل ذلك نطبق الشفرة التالي '-- OPEN XLS FILE AS REMOTE DATABASE Dim XLDB As DAO.Database Set XLDB = OpenDatabase( _ CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;") عند فتح مصنف أكسل كقاعدة بيانات سوف تصبح أوراق البيانات كجداول بيانات في أكسس، ولكي نتحقق من ذلك نستخدم الغرض TableDefs لسرد أسماء الجداول (أوراق البيانات) '-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs TD.Name Next :: عند النظر إلى ورقة البيانات في مصنف البانات نجد البيانات محصورة في العمودين (C,I) والبيانات ليست متساوية الطول وبالتالي نحن بحاجة إلى جعل كل عمود جدول بيانات مستقل! :: يوجد في مكون البيانات Recordset وظيفة اسمه Getrows تقوم بتجميع البيانات كمصفوفة بيانات يحدد طولها المستخدم حسب احتياجة. ولكون البيانات الطالب في ورقة البيانات تتكون من 5 صفوف؛ وبناءُ عليه سوف نقوم بتجميع البيانات على هذا الأساس. لكن يجب أن نقوم بأخذ عدد السجلات في الجدول (ورقة البيانات) والذي هو بالتأكيد من مضاعفات الـ(5). الوظيفة Getrows تقوم بأخذ المجموع التالية من السجلات عن اطلاقها مرة أخرى وبالتالي نحن بحاجة إلى دوارة بطول السجلات وتقوم بالقفز كل 5 سجلات، بمعنى (20/5). :: نقوم بعد ذلك بتسجيل البيانات في جدول الطلاب من مصفوفة البيانات التي تعيدها Getrows. :: سوف تدور الشفرة على جميع الجداول (أوراق البيانات) وتكرر جلب البيانات مرتين حسب أعمدة البيانات التي سبق الإشارة إليها. كما أنها تقوم بحذف الصفوف الفارغة عند جلب البيانات. الشفرة التالية توضح المبدأ السابق وطريقة نقل البيانات.. '-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs '-----------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (C) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing '--------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (I) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing Next إليكم الشفرة كاملة Option Compare Database Option Explicit Sub IMPORT_XLSDB() On Error GoTo SUB_CLOSE '-- OPEN CURRENT DATABASE AS LOCAL DB Dim DB As DAO.Database Set DB = CurrentDb '-- OPEN RS DB TO ADD DATA Dim DBRS As DAO.Recordset Set DBRS = CurrentDb.OpenRecordset("TABLE") '-- OPEN XLS FILE AS REMOTE DATABASE Dim XLDB As DAO.Database Set XLDB = OpenDatabase( _ CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;") '-- OPEN XLS SHEET AS REMOTE RS Dim XLRS As DAO.Recordset Dim RCROW() Dim RC As Long Dim I As Integer Dim TD As DAO.TableDef '-- LOOP THROUGH XLDB TABLES (SHEETS) For Each TD In XLDB.TableDefs '-----------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (C) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing '--------------------------------------------------------------------------------------' '-- RECORDS FROM COLUMN (I) IN XL SHEET Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)") '-- COUNT RECORDS XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS For I = 1 To RC Step 5 RCROW = XLRS.GetRows(5) DBRS.AddNew DBRS![ACADEMIC YEAR] = RCROW(0, 0) DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32))) DBRS![STNAME] = RCROW(0, 2) DBRS![F1] = RCROW(0, 3) DBRS![Sub] = RCROW(0, 4) DBRS.Update Next Set XLRS = Nothing Next SUB_CLOSE: '-- COLOSE XLDB AND XLRS Set XLRS = Nothing ' XLDB.Close Set XLDB = Nothing '------------------------' '-- CLOSE DB AND DBRS Set DBRS = Nothing XLDB.Close Set XLDB = Nothing End Sub وهذه هي المفرفقات التى تتضمن المثال... CS_SeetNumberLabels2.xlsxPosters.accdb

السلام عليكم 🙂 هذه الواجهة : 1. لما تفتح لك نافذة الاختيار ، تقدر تختار ملف واحد ، او عن طريق مسك زر Shift او Ctrl تقدر تختار اكثر من ملف ، 2. ستظهر لك اسماء الملفات اللي اخترتها هنا ، 3. هذا الزر اللي يجلب البيانات الى قاعدة البيانات ، 4. و بهذا الزر تختار المجلد ، ومنها يقوم البرنامج بجلب جميع ملفات الاكسل ، ويضع مسار الملفات في #2 . وهذه الاكواد ، 1. Private Sub Browse_Click() Dim varFile As Variant Me.txtPath = "" With Application.FileDialog(3) .title = "اختار ملف او عدة ملفات" .Filters.Clear .Filters.Add "Excel Files", "*.xls ; *.xlsx" '.Filters.Add "Excel Files", "*.csv" .AllowMultiSelect = True 'False .InitialFileName = "" If .Show = -1 Then 'Loop through each file selected and add them to the textbox For Each varFile In .SelectedItems Me.txtPath = varFile & vbCrLf & Me.txtPath Next End If End With End Sub . 4. Private Sub cmd_All_Files_In_Folder_Click() Dim strPattern As String, myDir As String, varFile As String If MsgBox("هل أنت متأكد من رغبتك في استيراد جميع الملفات" & objName & "؟", vbCritical + vbYesNo + 256, "تأكيد") = vbYes Then 'Important we use msoFileDialogFolderPicker instead of (...)FilePicker With Application.FileDialog(4) 'Optional: FileDialog properties .title = "Select a folder" .InitialFileName = "C:\" If .Show = -1 Then Me.txtPath = "" strPattern = "*.xls" 'Loop through each file selected and add them to the textbox myDir = .SelectedItems(1) & "\" varFile = Dir(myDir & strPattern, vbNormal) Do While varFile <> "" Me.txtPath = myDir & varFile & vbCrLf & Me.txtPath varFile = Dir Loop End If End With End If End Sub . 3. هذا الكود ينادي بقية الوحدات النمطية ، Private Sub Command1_Click() CurrentDb.Execute ("Delete * From Table1") CurrentDb.Execute ("Delete * From Temp4") 'call for multiple WorkBooks Call f_Import_WorkBooks("Temp4") MsgBox "تم استيراد البيانات بنجاح" End Sub f_Import_WorkBooks علشان سهولة استعمال الكود لملفات مثل هذه الملفات ، استيراد جميع الاوراق من الاكسل ، من جميع الملفات في المجلد ، وما له علاقة بكود استيراد البيانات (هذا الكود الذي ينادي الوحدة النمطية لإستيراد البيانات Call f_Import_to_Table(colWorksheets(lngCount)) ) ، مع ملاحظة ان هذا الكود لا يتغير بتغير نوع الملفات من موقع النور : Public Function f_Import_WorkBooks(strTable As String) 'import Sheets Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String Dim strPassword As String 'For Multiple files Dim x() As String x = Split(Me.txtPath, vbCrLf) For i = LBound(x) To UBound(x) - 1 strPathFile = x(i) ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Replace tablename with the real name of the table into which the data are to be imported 'strTable = "Temp4" '"tablename" ' Change this next line to True if the first row in EXCEL worksheet has field names blnHasFieldNames = False ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString) strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 'Empty Table CurrentDb.Execute ("Delete * From " & strTable) DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" 'save Results to Table Call f_Import_to_Table(colWorksheets(lngCount)) Next_lngCount: Next lngCount 'looping for Multiple files Next i ' Delete the collection Set colWorksheets = Nothing End Function . f_Import_to_Table وهنا نعمل الكود لإستيراد البيانات من الاكسل ، وهو الكود الذي يحتاج الى تغيير ، كلما اردنا استيراد بيانات مختلفة من موقع النور : Public Function f_Import_to_Table(Sheet As String) Dim myField As String Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset Dim i As Long, j As Long Set rst2 = CurrentDb.OpenRecordset("Select * From Table1") 'يوجد عمودين لكل ورقة :F2 AND F8 For j = 2 To 8 Step 6 myField = "F" & j Set rst1 = CurrentDb.OpenRecordset("Select " & myField & " From Temp4 Where " & myField & " Is Not Null") rst2.AddNew Do Until rst1.EOF i = i + 1 If i = 1 Then rst2![Academic Year] = rst1(myField) rst2!Sheet = Sheet ElseIf i = 2 Then rst2![Academic Num] = Mid(rst1(myField), InStrRev(rst1(myField), " ") + 1) ElseIf i = 3 Then rst2![StName] = rst1(myField) ElseIf i = 4 Then rst2![F1] = rst1(myField) ElseIf i = 5 Then rst2![Subjects] = rst1(myField) i = 0 rst2.Update rst2.AddNew End If rst1.MoveNext Loop Next j rst1.Close: Set rst1 = Nothing rst2.Close: Set rst2 = Nothing End Function . بسبب انني فككت الكود اعلاه ، فالكود يفتح ويغلق Recorsets كثيرا ، مما يؤدي الى بطئ البرنامج (انا اعتبره بطيء ، ومو مثل ما اخوي محمد كان يتمناه بسرعته 🙄 ) ، ولكن اذا صار عندي وقت ان شاء الله انظر فيه مرة اخرى 🙂 جعفر 1206.2.Posters.mdb_accdb.zip

الله عليك استاذ أحمد الفلاحجى

ولا يهمك اخى محمد جرب الان ووافنى بالنتيجه جزاك الله خيرا اخى @husamwahab التقيم1.accdb

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

أكثر من مرة أكرر انه لا يجوز ان يكون في جداول الاكسل خلايا مدمجة ويكون مستقلاً عن اي بيانات اخرى (ليس فقط في ازمة كورونا بل في كل الأحوال) تم ادراج صف فارغ لتحييد الجدول (الصف رقم 6) الماكرو Option Explicit Sub Filter_Class() If ActiveSheet.Name <> "Feuil1" Then Exit Sub Dim F As Worksheet Dim D1 As Object, D2 As Object, D3 As Object Dim i%, a As Boolean, b As Boolean, c As Boolean Dim x%, y%, m%, z%, arr, ky Dim st$ Set F = Sheets("Feuil1") Set D1 = CreateObject("Scripting.Dictionary") Set D2 = CreateObject("Scripting.Dictionary") Set D3 = CreateObject("Scripting.Dictionary") With F .Range("P7").CurrentRegion.ClearContents .Range("Ad7").CurrentRegion.ClearContents .Range("P27").CurrentRegion.Offset(1).ClearContents i = 8 Do Until i = 39 st = Mid(Trim(.Cells(i, 2)), 1, 1) Select Case st Case "3": a = True: b = False: c = False Case "2": b = True: a = False: c = False Case Else: b = False: a = False: c = True End Select arr = Application.Transpose(.Cells(i, 2).Resize(, 13)) arr = Application.Transpose(arr) If a Then D3(z) = Join(arr, "*"): z = z + 1 ElseIf b Then D2(y) = Join(arr, "*"): y = y + 1 Else D1(x) = Join(arr, "*"): x = x + 1 End If i = i + 1 Loop m = 7 If D3.Count Then For Each ky In D3 .Cells(m, "P").Resize(, 13) = Split(D3(ky), "*") m = m + 1 Next ky End If m = 7 If D2.Count Then For Each ky In D2 .Cells(m, "AD").Resize(, 13) = Split(D2(ky), "*") m = m + 1 Next ky End If m = 27 If D1.Count Then For Each ky In D1 .Cells(m, "P").Resize(, 13) = Split(D1(ky), "*") m = m + 1 Next ky End If .Range("P7").CurrentRegion.Value = _ .Range("P7").CurrentRegion.Value .Range("Ad7").CurrentRegion.Value = _ .Range("Ad7").CurrentRegion.Value .Range("P27").CurrentRegion.Value = _ .Range("P27").CurrentRegion.Value End With End Sub الملف مرفق Te3dad.xlsm

السلام عليكم تفضل اخي الكريم ارجو ان يكون طلبك Root5.rar

السلام عليكم مرفق قاعدة البيانات الموضوع : كود صغير لانشاء مجلد باسم معين وفي مكان محدد على الكمبيوتر المكان المرفق بالقاعدة سطح المكتب الخاص بي كل ما عليك تغيير المكان بين الكوتيشن وجرب انشاء مجلد.accdb

الله يعطيك العافية يا ابا اشرف

الكثير منّا يحاول ادخال التاريخ في الكومبوبوكس لكن المشكلة انه يظهر بالتنسيق الأميركي (شهر /يوم /سنة) بحلية بسيطة يمكننا ان نخدع الاكسل لأدخال التاريخ في الكومبوبوكس كما نريد نحن (يوم/شهر/ سنه) اذ ليس الامر باختياره انظر الى الملف المرفق لتعرف ماذا اعني Reel_date_to Combo.xlsm

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

أعتذر عن هذا الخطأ غير المقصود.. إليك التصحيح.. Posters.accdb

بعد اذنك أخي @احمد الفلاحجي تابع الصور أخي الكريم

السلام عليكم ورحمة الله وبركاته الاخوة الكرام واساتذتي الافاضل توجهت لمنتداكم الكريم للمساعدة في كيفية طباعة شيت به بيانات اكثر من 500 تلميذ مرة واحدة بدلا من صفحة تلو الاخرى والحمد لله تم العمل بتعاون الاخوة الافاضل سواء هنا او بمنتدى اخر وقمت بالتعديل والاضافة حسب معرفتي البسيطة بالمعادلات والاكواد واعترافا بالفضل اضع بين ايديكم هذا العمل المتواضع ملف شيت به 8 شهادات بالصفحة الواحدة البيانات بالشهادة 1 -اسم المستخدم او كود التلميذ مضاف اليه moe 2 - الاسم الاول 3 - اسم العائلة 4 - رمز الصف وهو عبارة عن رمز اي صف من الصفوف المسجلة ببالبند رقم 5 ( للتسحيل للمرة الاولى فقط ) 5 - رمز فصل ل5 مواد وهي ( لغة عربية - لغة انجليزية - رياضيات - علوم - دراسات ) جدول لكتابة المشروعات المطلوبة من التلميذ مرفق ملف مضغوط به 2 شيت واحد بدون حماية لمن اراد التعديل وملف لمن لا يجيد المعادلات ويخشى ان يغير شئ ويضيع تعبه سدى حتى الحمايةجعلتها بدون كلمة سر شيت طباعة بيانات ادمودو للتلاميذ.zip

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

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

اللهم امين واياكم اخى محمد اتفضل اخى محمد @حلبي وانا اخوك الصغير ان شاء الله يكون ما تريد التقيم(1).accdb

السلام عليكم اهلا اخى محمد @حلبي مشاركه مع اخوانى واساتذتى @husamwahab و @kha9009lid جزاهم الله خيرا اولا غير حقل الدرجه واجعله نصى ثم ادخل الدرجات وبدون استخدام الوحده النمطيه حاجه على قدى علشان خاطرك اخى محمد حلبى التقيم(1).accdb

هل هذا هو المطلوب التقيم.accdb

على الرغم انك لم ترفق ملف لكن انظر الى هذا الملف لعلك تستفيد منه واعتقد انه المطلوب timer.xls

لم أتعود على كتابة الأمثلة وهذه مقدرتي ، من يمتلك هذه الملكة فليقوم بالاختبارات وعمل أمثلة أكثر وضوحا. من أهم ما أشدد على الالتزام به هو أن تستخدم دالة تحويل التاريخ إلى رقم لجهتي المقارنة أي حقل الجدول و قيمة البحث. Sub Test4() Dim TestDate As Date Dim SearchText As String '----------------------------------------------------------- 'المعتاد SearchText = "Birthdate=" & #10/4/2020# 'الاحترازي TestDate = DateSerial(2020, 4, 10) SearchText = "CLng(Birthdate)=" & CLng(TestDate) '-------------------------------------------------------- 'المعتاد SearchText = "Birthdate=" & #10/4/2020 11:43:30 PM# 'الاحترازي TestDate = DateSerial(2020, 4, 10) + TimeSerial(23, 43, 30) SearchText = "CDbl(Birthdate)=" & CDbl(TestDate) End Sub Sub Test5() Dim SearchText As String SearchText = #10/4/2020# Debug.Print CDate(SearchText) 'الناتج 04/10/2020 Debug.Print DateSerial(2020, 4, 10) 'الناتج 10/04/2020 '-------------------------------------------------------- SearchText = #4/13/2020# 'كتبتها 13/4/2020 وحولها المحرر 4/13/2020 Debug.Print CDate(SearchText) 'الناتج 13/04/2020 Debug.Print DateSerial(2020, 4, 13) 'الناتج 13/04/2020 End Sub

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

تسلم

كل المحبة والاحترام

احسنت يا ابا اشرف

لفتت نظري هذه الطريقة واردت التأكد من فاعليتها قمت بعمل حلقة تكرارية لتوليد 50000 سجل تاريخ لعدد اربعة حقول كل منها بتنسيق مختلف ومن ثم عملت مقارنة في قيمة الحقول الاربعة بعد تحويل التاريخ الى رقم وكانت النتيجة ممتازة مع ذلك النتيجة هنا قد لا تكون حاسمة لكون التاريخ يتأثر بصيغة التاريخ في نظام التشغيل لذك قمت بنقل المثال على الشبكة وقمت بتغيير صيغة التاريخ في الاجهزة المتصلة وكانت النتيجة ايضا ممتازة في المقارنة وفي البحث وفي معايير دوال التجميع مع ذلك الطريقة التي استخدمها Format([da_te];"\#mm\/dd\/yyyy\#") تعطي نفس النتيجة وكذلك الوحدة الخاصة بالاستاذ @jjafferr تعطي نفس النتيجة وتمتاز من وجهه نظري بالسهولة DateFormat([d_date]) في الحقيقة من اجمل المواضيع التي شدت انتباهي

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

ههههههههههههههههههه ما ودك رسل لي اثنين من الشباب ذولي يدرسوني ؟؟

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

جزاك الله خيرا أخي @jjafferr فيه مثل عندنا يقول : ( ما أبطى السيل إلا من كبره ) ومعناه انه ( ما تأخر السيل إلا من كثرته وغزارته ) أنا شاكر لك ومقدر .. لكن عندي سؤال : ( الشباب ما فزعوا معك ؟؟ ) هههههههه سأوافيك بالنتائج بإذن الله ..

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

اخي @أحمد الفلاحجى انت رائع جدا ومتواضع لاخوانك قال رسولنا الكريم عليه افضل الصلاة واتم التسليم (ما نقصت صدقةٌ من مال، وما زاد الله عبداً بعفوٍ إلَّا عزَّاً، وما تواضع أحدٌ لله إلَّا رفعه الله) بشان التعديل جميل واستخدام الدوال بشكل رائع طبعا يمكن الاستغناء عن الاستعلام ووضع الحقلين المحسوبة بشكل مباشر في النموذج ويمكن الاستغناء عن الحقلين باستخدام الكود متغيرات وتنسيق ولكن عملك الجميل يغني عن كل ذلك تقبل مني كل الود والاحترام

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

تسلم اخى بارك الله فيك وبارك الله فى الاخت زهرة العزيزة هو فعلا المطلوب تسلم اخلى الغالى بارك الله فيك .. فعلا هو المطلوب ولكن لى سؤال .. ما هو اكتر نوع خط باركود يعمل على كل الاجهزة .. هل هو 39 ولا ال 128 ولا غيرهم

وعليكم السلام-بارك الله فيك وجزاك الله كل خير

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

مشاركه لاخوانى واساتذتى @اشرف و @محمد ابوعبد الله جزاهم الله خيرا والحقول التى ذكرتها 5 ولم تذكر الجداول عالعموم شوف شاشه اجمالى عدد النقاط وشوف الاداره العليا ثم اكمل بنفسك وان لم تستطع وضح الجداول والحقول وما تريده بامثله من واقع الجداول والبيانات New folder.rar

حيث انكا لم ترفع ملفاً للمعاينة اقترح هذا الملف الذي يمكن تعديله كما تريد Working time.xlsx

السلام عليكم تفضل احي الكريم الكود بعد التعديل Private Sub title_BeforeUpdate(Cancel As Integer) Dim rslt As String DoCmd.SetWarnings False If DCount("*", "table1", "[title]='" & Me.Title & "'") > 0 Then Beep If MsgBox("warnnig", vbQuestion + vbYesNo, "deplucate") = vbNo Then Cancel = True Me.Undo End If End If End Sub تحياتي

تفضل اخي الكريم Root10.rar

الف شكر استاذ ابو طيبة للمشاركة

رابط فيديو 2 لشرح برنامج قوائم الفصول https://youtu.be/nAosm1dqUWI رابط شرح قوائم الفصول فيديو 3 https://youtu.be/V5QIoAvxKZQ

وعليكم السلام 🙂 شكرا جزيلا على هذا الشرح ، بس لو تكرمت واكملت الشرح بأمثله ، علشان يكون الموضوع واضح ومكتمل 🙂 جعفر

؟

تفضل لك ما طلبت القيد2.xlsm

الــدرس الرابع: الجملة الشرطية ( IIF ) ( لقد قام أستاذي و أخي جعفر حفضه الله بتقديم هذا الدرس كله و أنا لم أفعل شيء سوى التنسيق و النشر فاللهم جازيه عنا خير الجزاء يا رب العالمين) طريقة استعمال ((iif: iif(expr, truepart, falsepart) iif(القيمة المطلوب تقييمها, اذا كان التقييم صح فستأخذ هذه القيمة, اذا كان التقييم خطأ فستأخذ هذه القيمة) مثال: Age=50 Age_Now = iif(Age=50 , "Yes it is", "No it is not") ميزاتها: نستطيع استعمالها في الكود ، والاستعلام نستطيع ان نضع اكثر من شرط واحد فيها مثال: Price=10 Qty=5 Sale_is= iif(Price* Qty = 50 , "Low sale", iif(Price * Qty = 100 , "Middle sale" , "Big sale")) عيوبها: الدالة تختبر جميع الحالات ، ولا تختبر القيمة الاولى وتخرج (مثل الـ IF): 1. المثال السابق ، مع ان اول تقييم هو الجواب الصحيح 10*5=50 ، إلا ان الدالة ستقوم بتقييم جميع الاختيارات ، مما يجعلها تأخذ وقت اطول للتقييم ، 2. بسبب اختبارها لجميع الحالات ، فيجب ان نكون دقيقين في وضع التقييم ، مثلا اذا اردنا اختبار قيمة مثال: Divide = iif(n2 = 0, MsgBox("القيمة صفر"), MsgBox(n1 / n2)) فاننا سنحصل على خطأ ، لأن الدالة تحققت من القيمتين ، والقيمة الثانية هي تقسيم رقم على صفر ، 3. بطيئه نوعا ما ، لأنها تحول الارقام الى Variant (رجاء مراجعة الدرس الاول للأخ صالح) ، ثم تقوم بالحساب ، 4. لا تستطيع ان تستخدم اكثر من 7 شروط في الاستعلام ، مثلا عندنا ارقام الاشهر ونريد نستخرج اسمائها ، 5. ببساطة مكن ان تخطأ في عدد الاقواس والفواصل ، 6. لا تستطيع قراءة ولا تغيير اي شئ بسهولة ، وخصوصا اذا كان عندنا اكثر من تقييم ، امثلة عملية: 1. اذا عندنا ارقام الاسبوع ، ونريد ان نستخرج ايامها ، فاذا عملنا الكود في الاستعلام مباشرة ، فسيكون صعب ، لذا ، فالطريقة التي اعملها انا هي: أ‌- عمل الكود في محرر VBA ، هكذا: لاحظ اني عملت اول شرط ونتيجة القيمة الصحيحة ، ثم انهيت السطر بخط سفلي _ (واللي معناه في البرمجة ان الكود سيتواصل في السطر التالي ، ثم انتقلت السطر التالي ، ونفس الشئ ، عملت الشرط التالي ونتيجة القيمة الصحيحة و.... كما سبق و... الى ان نوصل للسطر الاخير ، فوضعت الشرط الاخير ونتيجة القيمة الصحيحة والخطأ ، ثم حسبت كم قوس مفتوح ، فقفلت بنفس عددها: iDay = 2 Today_is = IIf(iDay = 1; "Sun"; _ IIf(iDay = 2; "Mon"; _ IIf(iDay = 3; "Tue"; _ IIf(iDay = 4; "Wed"; _ IIf(iDay = 5; "Thu"; _ IIf(iDay = 6; "Fri"; "Sat")))))) ب- والخطوة التالية ان نجعلها في سطر واحد ، حتى نأخذها للإستعلام ، وهي ان نحذف الاشارة _ ، لتكون النتيجة Today_is = IIf(iDay = 1; "Sun"; IIf(iDay = 2; "Mon"; IIf(iDay = 3; "Tue"; IIf(iDay = 4; "Wed"; IIf(iDay = 5; "Thu"; IIf(iDay = 6; "Fri"; "Sat")))))) . هكذا . 2. اذا عندنا سجلات الصف الاول والثاني ، واردنا معرفة عدد الطلاب لكل صف: iif([Section]= "A" ; 1;0) وهكذا تكون في الاستعلام: 3. اذا عندنا اكثر من 7 شروط (ارقام الاشهر نريد تحويلها الى اشهر) ، فهنا نضطر الى عمل وحدة نمطية: Function What_Month(M) Select Case M Case 1 What_Month = "Jan" Case 2 What_Month = "Feb" Case 3 What_Month = "Mar" Case 4 What_Month = "Apr" Case 5 What_Month = "May" Case 6 What_Month = "Jun" Case 7 What_Month = "Jul" Case 8 What_Month = "Aug" Case 9 What_Month = "Sep" Case 10 What_Month = "Oct" Case 11 What_Month = "Nov" Case 12 What_Month = "Dec" End Select End Function ونرسل لها ارقام الاشهر ، هكذا . والنتيجة

السلام عليكم ورحمة الله وبركاته تفضل اخي لعله يكون المطلوب حسب ما فهمت من كلامك عند اختيار عقاري او شخصي من القائمة المنسدلة تختفي أو تظهر النموذج الفرعي جرب ووافني بالنتيجة 7-10 new.rar