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

تفضل اخي الكريم 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

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا اتفضل اخى استخدم الكود التالى Me![img].Picture = Nz(DLookup("figura", "BASIC_DATE", "name='" & [name] & "'"), "") بالتوفيق ان شاء الله New_Microsoft_Office_Access_Application.mdb

اخوانى الافاضل السلام عليكم لدينا كارت لتقييم كل موظف فى النموذج المرفق كل موظف له تقييم خاص به حسب القسم التابع له المفروض ان الدرجة تكتب هكذا ( 50-20) ومعناها من 20 الى 50 وهذا المعدل يختلف بين موظف واخر المفروض حسب قوانين ولائحة الشركة ان لايزيد عن 50 ولا يقل عن 20 فاذا زاد او قل يتلون حقل التقييم (EV) باى لون وليكن الاحمر فمثلا الموظف محمد كتب له فى حقل التقييم 35 يتلون له حقل التقييم باللون الاخضر واذا كتب له 19.5 يتلون حقل التقييم بالون الاحمر علما بانى اثناء محاولاتى لم اتمكن من ادخال الشكل من ..... الى ..... في الحقل ولم اعرف الخائص المطلوبه لهذا الرقم ويلاحظ بعض الاحيان يكون المعدل عبارة عن كسر مثلا من 12.5 الى 60.5 جزاكم الله خيرا التقيم.accdb

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

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

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

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

بالتوفيق

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

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

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

أستاذ الدهشوري لما لا تقوم بالضغط على الإعجاب لهذه الإجابة الممتازة ؟!!!💙 والله استعجب واستغرب كثيرا لهذا الأمر ... هل هذا تعالى وكبرياء ام ماذا ؟!!! طالما انك تحصلت على ما تريد وكان هذا بفضل ربنا وفضل الأستاذ علي ,لماذا لا تقدم له أقل شيء مطالب ان تقدمه له مقابل حل مشكلتك وهو الضغط على الإعجاب له على حله لمشكلتك ؟

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

وعليكم السلام اخى صفوت راجع المشاركه التاليه لاختنا ومعلمتنا العزيزه زهره جزاها الله كل خير ان شاء الله تجد بها الحل لما تريد http://arabteam2000-forum.com/index.php?/topic/278727-جهاز-الباركود-لا-يقرأ-الملصق-أين-المشكلة؟؟/&do=findComment&comment=1343520 بالتوفيق ان شاء الله

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

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

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

الاستاذ / @husamwahab الله عليك والله حل عبقرى جزاك الله خير ورحم الله والديك فى الدنيا والاخرة ورزقك الله رزقا كثيرا نعم هو المطلوب وافهم من ذلك ان الحل يلزم عمل هذا الاستعلام وفنكشن معه وكذلك عمل conditional يعنى ثلاث اشياء اسمح لى ان اثقل عليك وتحملنى الا يمكن عمل ذلك بشكل مبسط بعض الشئ يعنى يااما استعلام او فنكشن وان كانت الاجابة لا ـ فأنا مكتفى بذلك واحمد الله على هذه النتيجه الممتازة العبقرية جزاكم الله كل خير ـ وجعله في ميزان حسناتكم ان شاء الله

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

رابط اخر http://www.helenfeddema.com/Files/access.htm

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

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

؟

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

اخينا @wael gaper الكود سليم ويتم عرض اخر سجل في مجموعة السجلات ولكن يبقى ماهو اخر سجل ؟ فالجدول به البيانات غير مرتبه لذلك كيف نضمن ان اخر سجل نريده هو اخر سجل بمجموعة السجلات . نقوم بعمل ترتيب صريح اما من خلال الجدول وتكون مرئيه علامة الفرز بالجدول عند فتحه او تقوم بفتح السجلات بجملة اس كيو ال متضمنه امر الفرز وحسب ماتريد غير اسم الجدول وعمود الفرز وعذرا اكتب من الموبايل بالتوفيق

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