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

اسهل طريقة اعمل استعلام 1 ثم ضع فيه معيار تصفية Between Nz([forms]![FQin]![f2];"01/01/1900") And Nz([forms]![FQin]![t2];"01/01/2100") ثم اعمل استعلام 2 ويكون فيه التجميع واجعله مصدر للنموذج FF.accdb

زيادة في اثراء الموضوع =IF(COUNTIF(A2:C2,"غ")=3,"غ",IF(SUM(A2:C2)=0,"صفر",SUM(A2:C2))) Abscent.xls

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

هذا هو توجيهي لك .. هل حلت مشكلتك ؟

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

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

هل تقصد هذه .....

تفضل المرفق ..... استعلام حركة البع والسداد.rar

طيب انت الان هجولتنا .... موضوعين حول نقطة واحدة .... هلا صبرت علينا حتى نفهم ما تريد ونستطيع الاجابة ......

هل تصوري للموضوع صحيح انظر الصورة ...

وعليكم السلام وذلك بسبب ان طريقة الحساب لديك كانت Manual اجعلها كما بالصورة

شكرا جزيلا اخي الكريم الله يعطيك الف عافية

ننصحك قبل البدء 80% من الجهد في المشروع هو في تصميم وضبط الجداول ، فلا تنتقل الى غيرها حتى ترى الضوء الاخضر من الاساتذة هنا 1- ابتعد تماما عن كتابة اسماء الكائنات ( الجداول والحقول وغيرها ) بحروف عربية ، وانما التسميات العربية تكتب في الخصائص فيما يسمى التسمية التوضيحية 2- لاتجعل مسافات فارغة في الأسماء 3- ارفع عملك هنا كي يطلع عليه الاعضاء هنا ويتمكنوا من مساعدتك وتوجيهك اتمنى لك التوفيق ،،،

هذا الكود مبدئياُ من أجل القوائم المنسدلة (المترابطة) اذا لم تظهر القائمة الرئيسية في النطاق من B7 الى B31 من الصفحة (FATURA) غادر الضفجة ثم عد اليها من جديد Option Explicit Dim D As Worksheet, S As Worksheet Dim F As Worksheet Dim LrD%, LrS%, lrF% '+++++++++++++++++++++++++++++++++ Private Sub Worksheet_Activate() data_val End Sub '++++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Change(ByVal Target As Range) Dim K%, t%, F_rg As Range Dim sec_arr(), mm%, y% Dim BoL As Boolean Dim Dt As Worksheet Set Dt = Sheets("DATA") Application.EnableEvents = False If Not Intersect(Target, Range("B7:B31")) Is Nothing And _ Target.Count = 1 Then If Target <> "" Then Set F_rg = Dt.Range("D1:K1").Find(Target, lookat:=1) If F_rg Is Nothing Then GoTo Fin BoL = True t = F_rg.Column mm = 2 Do Until Dt.Cells(mm, t) = "" ReDim Preserve sec_arr(1 To mm - 1) sec_arr(mm - 1) = Dt.Cells(mm, t) mm = mm + 1 Loop End If If BoL And mm > 2 Then With Target.Offset(, 1).Validation .Delete .Add 3, Formula1:=Join(sec_arr, ",") End With y = Application.RandBetween(1, mm - 2) Target.Offset(, 1) = sec_arr(y) End If End If Fin: Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++++++++ Sub Begin() Set D = Sheets("Data") Set S = Sheets("SALES") Set F = Sheets("FATURA") LrS = S.Cells(Rows.Count, 1).End(3).Row lrF = F.Cells(Rows.Count, 2).End(3).Row End Sub '++++++++++++++++++++++++++++++++++++++++ Sub data_val() Begin Dim ro%, i%, arr() ro = D.Cells(Rows.Count, 1).End(3).Row ReDim arr(1 To ro - 1) i = 2 Do Until i = ro + 1 arr(i - 1) = D.Cells(i, 1) i = i + 1 Loop With F.Range("B7").Resize(25).Validation .Delete .Add 3, Formula1:=Join(arr, ",") End With End Sub الملف مرفق My_Bok.xlsm

السلام عليكم ورحمة الله وبركاته أتمني من الله العلي القدير أن تكونوا في أتم الصحة والعافية وبجهود الأخوة الأكارم في هذا المنتدى المبارك انتهيت اليوم من عمل ملف لحفظ وتثبيت القرآن الكريم أسأل الله تعالى أن يكتب الأجر للجميع وهو الآن تحت تصرف الإخوة في المنتدي لنشر الخير وكذلك إبداء الملاحظات والأفكار إن وجدت للأسف حاولت رفع الملف ورفض الموقع لأن حجمه أكثر من 1000كيلو بايت وهذا للتعليمات والأخر هو الملف .... تــــم رفع الملفات داخل المنتدى , لإكتمال الإستفادة تعليمات-برنامج.pdf 1270891612_----.xlsm

استاذي الخلوق احمد كامل السيد جزاء الله كل الخير تم حل المشكلة دمت بحفظ الله وامنه

وعليكم السلام-فقط استخدم هذه المعادلة =CONCATENATE($E2," ",$BC2," ",$F2) مواقع استخدام العناصر 201.xlsx

ادا كان ما تقصد هو تعبئة عمود السن القانوني بتاريخ السن الميلاد + 52 سنة جري هذا الماكرو واضا الاسم الثلاثي Sub Test() Dim x, lr lr = Cells(Rows.Count, "ay").End(xlUp).Row For x = 2 To lr If Cells(x, "ay") = vbNullString Then GoTo 1 Cells(x, "be") = Format(DateAdd("yyyy", 52, Cells(x, "ay")), "dd-mm-yyyy") Cells(x, "bf") = Cells(x, "d") & " " & Cells(x, "bc") 1: Next x End Sub مواقع استخدام العناصر 2021 - Copy.xlsm

السلام عليكم في المرفق ستجد نموذجاً ابدأ بزر التصدير بعد التعديل على البيانات في جدول الأكسس ثم عد و استورد بعد التعديل على البيانات في ملف الإكسل الطريقة هي: بتصدير الجدول بصيغة إكسل و سيكون موقع الحفظ في جوار قاعدة البيانات. ثم وضع ملف الإكسل إلى جانب قاعدة البيانات في الحاسوب الثاني. ثم استيرادها بنقر مفتاح استيراد. أرجو أن يكون هذا ما تبحث عنه. ImpoertExport.accdb

السلام عليكم لاحظت تكرار بعض البيانات ، فاليك النسخة المعدلة 275.1.ImportDegrees.accdb.zip

حيا الله من يانا وهذه طريقة اخرى ، اذا كانت ملفاتك تنزلها من موقع النور ، التابع لوزارة التعليم في المملكة العربية السعودية جعفر 275.1.ImportDegrees.accdb.zip

السلام عليكم . هذا صحيح ، ولكن في نهاية الدالة تستطيع تختار النطاق Range او الورقة/sheet ، فعليه يمكنك ان تعيد الامر اكثر من مرة ، كل مرة لورقة اكسل اخرى (لاحظ اسماء الـSheet): DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" . ولكن هذا الامر يتطلب منا ان نعرف عدد الاوراق/Sheets ، واسمائها ------------------------------------------------------------------------------------------------------------------------ والآن لشرح ما عملته انا: 1. عملت جدول اسمه tbl_Sheets ، لإدخال جميع المعلومات في جميع الاوراق/Sheets: . وعن طريق الكود (الكود سيكون في نهاية الموضوع) ، يأخذ البيانات ، فيصبح: . ثم يأتي الكود مرة اخرى ، فيملئ حقل ID لكل علامة: . ثم عملت استعلام جدولي CrossTab ، والذي به نستطيع ان نجعل بيانات احد الاعمدة عبارة عن اعمدة متفرقة ، يعني الحقل F1 ، اردنا ان نجعل كل مادة عبارة عن عمود مستقل): . وهذه نتائجه: . والان الى عمل استعلام آخر ، لجمع كل هذه السجلات: . فاصبحت: . الآن وقد اصبحت البيانات جاهزة لإلحاقها بالجدول النهائي Degrees ، نعمل استعلام الحاقي: . والكود الذي يقوم بكل العمل: Private Sub ImportData_Click() 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" 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, strTable As String Dim strPassword As String ' 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 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = Me.txtPath ' "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tbl_Sheets" '"tablename" ' 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 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing '--------------------------------- ' importing is finished 'now organize the table, by adding the ID to all the group Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Sheets") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If rst!F1 = "رقم الهوية" Then 'And Len(rst!ID & "") = 0 Then myID = rst!F2 rst.Edit rst!ID = myID rst.Update Else rst.Edit rst!ID = myID rst.Update End If rst.MoveNext Next i rst.Close: Set rst = Nothing 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery "qry_Append_Sheets" DoCmd.SetWarnings True MsgBox "Done" ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub . . ولكن ، يجب عليك ان تحذف بيانات الجداول Degree و tbl_Sheets قبل ان تقوم بأي عمل جعفر 275.ImportDegrees.accdb.zip