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

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

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

تسلم

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

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

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

اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

رحم الله والديك ، كفيت ووفيت 🙂 في الواقع في منها امثلة جديدة علي 🙂 جعفر

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

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

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

وعليكم السلام هل هذا ما تريد ؟ __assa5.rar

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

بالتوفيق

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

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

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

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

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

يمكنك استخدام هذه المعادلة =IF(AND(WEEKDAY($B4)=6,$C4="حضور"),1,"") حساب يوم الجمعة2.xlsx

لا حاجة الى هذه الشروط المتكررة من IF يكفي ادراج جدول بالأسعار واستعمال الدالة VLOOKUP لهذا الغرض في العامود I نطرح قيمة الكسب اما في العمود J نطرح عدد ثابت 50 (لا أعرف ايهما تريد) انظر الى الملف Moufafaa.xls

IsDate: تستخدم هذه الدالة لفحص ما إذا كان المتغير الممرر لها تاريخ أم لا حيث تعيد true إذا كان المتغير تاريخاً و تعيد false إذا لم يكن تاريخاً. IsDate(«تعبير») IsDate("12/03/2017")=True IsDate("أوفيسنا")=False Now: تستخدم هذه الدالة لإستخراج تاريخ و وقت النظام الحاليين. Now() و تكون النتيجة بالشكل التالي: 15-03-2017 10:18:15 Time: تستخدم هذه الدالة لإستخراج وقت النظام الحالي. Time() و تكون النتيجة بالشكل التالي: 10:18:15 Timer: تستخدم هذه الدالة لإستخراج عدد الثواني منذ منتصف الليل. Timer() MonthName: تستخدم هذه الدالة لإرجاع اسم الشهر المحدد . MonthName(«اختصار», «شهر») MonthName(3,True)="مارس" MonthName(8)="أوت" TimeSerial: تستخدم هذه الدالة لإرجاع متغير من نوع تاريخ يحتوي على الوقت لساعة و دقيقة و ثانية محددة. TimeSerial(«ثانية», «دقيقة», «ساعة») TimeSerial(10, 56, 13)=10:56:13 Weekday: تستخدم هذه الدالة لإرجاع متغير "عدد صحيح" يمثل رقم اليوم في الأسبوع. Weekday(أول أيام الأسبوع, التاريخ) Weekday("15/3/2017", vbSunday)=4 WeekdayName: تستخدم هذه الدالة لإرجاع اسم اليوم المحدد من الأسبوع. WeekdayName(«أول أيام الأسبوع», «اختصار», «يوم من الأسبوع») WeekdayName(3, True, vbSunday)="الثلاثاء" و هذه هي القيم المستعملة لتحديد أول أيام الأسبوع: vbUseSystem سيتم استخدام إعدادات النظام vbSunday يمثل يوم الأحد vbMonday يمثل يوم الاثنين vbTuesday يمثل يوم الثلاثاء vbWednesday يمثل يوم الأربعاء vbThursday يمثل يوم الخميس vbFriday يمثل يوم الجمعة vbSaturday يمثل يوم السبت

الــدرس الرابع: الجملة الشرطية ( 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 ونرسل لها ارقام الاشهر ، هكذا . والنتيجة

الدرس الثالث: الدالة Select Case تشبه الدالة Select Case إلى حد كبير الدالة If و لكنها تختلف عنها بالتعدد أي أنها تكون في الشروط المتعددة. طريقة الاستعمال: الصيغة الأولى: Select Case Expression Case Expression_1 Statement_1 Case Expression_2 Statement_2 Case Expression_n Statement_n End Select تقوم الدالة Select Case باختبار حالة الكائن أو المتغير Expression و مقارنتها أو مطابقتها مع الحالات الموجودة بداخلها. و عند تحقق الشرط مع إحدى الحالات يقوم البرنامج بتنفيذ التعليمة Statement التابعة لهذه الحالة. و عند عدم مطابقة الكائن أو المتغير لجميع الحالات فإن البرنامج لا يعطينا أي نتيجة. مثال1: كتابة الأرقام من 1 إلى 4 بالحروف Select Case me.le_nombre Case 1 Me.y = "واحد" Case 2 Me.y = "إثنان" Case 3 Me.y = "ثلاثة" Case 4 Me.y = "أربعة" End Select أضفنا مربع نص اسمه le_nombre لإدخال الأرقام و مربع نص اسمه y من أجل ظهور النتيجة. الصيغة الثانية: Select Case Expression Case Expression_1 Statement_1 Case Expression_2 Statement_2 Case Expression_n Statement_n Case Else Other_statement End Select في هذه الصيغة عند عدم تحقق الشرط مع جميع الحالات يتم إرجاع التعليمة الإستثنائية Other_statement مثال2: نفس المثال الأول Select Case me.le_nombre Case 1 Me.y = "واحد" Case 2 Me.y = "إثنان" Case 3 Me.y = "ثلاثة" Case 4 Me.y = "أربعة" Case Else me.y = "هذا الرقم غير موجود" End Select هذا عندما نضيف أي رقم يختلف عن 1 أو 2 أو 3 أو 4 يطبع لنا "هذا الرقم غير موجود" مثال 3: برنامج كتابة ملاحظات التلاميذ حسب الدرجة Select Case Me.Degre Case 0 To 30 Me.y = "ضعيف" Case 30 To 49 Me.y = "دون الوسط" Case 50 To 69 Me.y = "مقبول" Case 70 To 89 Me.y = "جيد جدا" Case 90 To 100 Me.y = "ممتاز" Case Else Me.y = "هذه الدرجة خاطئة" End Select هنا إستخدمنا To معناه إلى مثلا: من 0 إلى 30

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