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

النموذج السادس : قوائم منسدلة وأزرار جانبية 🙂 وملف التحميل 🙂 صفحة رئيسية مطورة - النموذج السادس.rar

وعليكم السلام ورحمة الله وبركاته.. الظاهر من سؤالك انك لاتعلمين شيئا عن اكسس (على افتراض انك تريدين تعلم اكسس) نصيحتي ان هناك العشرات من الفيديوهات في بناء نماذج المشتريات والمبيعات وربط الجداول للعديد من الاساتذة ..وهذا لن ياخذ وقتا طويلا للتعلم .. ويمكنك بعد بناء مشروعك حتى ولو كان بسيظا ان تطرحي الاسئلة في الموقع عن اي شيء يخطر في بالك حتى يكتمل بناء مشروعك

وعليكم السلام 🙂 اهلا وسهلا بك في المنتدى 🙂 للإستفادة القصوى من المنتدى ، رجاء قراءة قوانين المنتدى: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة اذا اردتي المساعدة في عمل برنامجك اعلاه ، فيجب عليك ارفاق ما قمتي به ، واخبارنا عن الاماكن التي تعانين مشكلة فيها ، حتى يستطيع الاعضاء مساعدتك ، ولكن تذكري ، من شروط المنتدى وضع سؤال واحد في كل موضوع ، ويمكنك فتح مواضيع اخرى لكل سؤال 🙂 اما اذا اردتي ان يقوم احد الاعضاء بعمل برنامجك بمقابل ، فرجاء كتابة الطلب هنا: https://www.officena.net/ib/forum/157-إعلانات-شخصية-بأجر-للاعضاء/ جعفر

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم البيانات.rar تحياتي

ما شاء الله تبارك الله .... مبدع @Moosak

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

جرب هذا التعديل اخى الكريم Option Explicit Sub MyStuNames() Dim Rng1 As Worksheet, Rng2 As Worksheet, T As String, Y As Integer, X As Double, Cel As Range, i As Integer Application.ScreenUpdating = False Set Rng1 = Worksheets("StudNames"): Set Rng2 = Worksheets("Analysis") T = Rng2.[AB1] X = Application.CountIf(Rng1.Range("B:B"), T) Y = IIf(Range("LangCod") = 2, 5, 4) Rng2.Range("B8:C42") = Empty i = 1 For Each Cel In Rng1.Range("B2:B" & Rng1.Cells(Rows.Count, 2).End(xlUp).Row) If Cel = T Then Rng2.Cells(7 + i, "B").Value = i Rng2.Cells(7 + i, "C").Value = Rng1.Cells(Cel.Row, Y).Value i = i + 1 End If Next Application.ScreenUpdating = True End Sub

لولا البروق واللمعات التي تظهر أثناء الضغط على الأزرار لكان الوضع أفضل نوعا ما 😅

طيب استخدم هذا الكود ........ DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Tablex", m_strFileName, True Dim s As Integer Dim rst As DAO.Recordset Dim rst2 As DAO.Recordset Dim dbs As DAO.Database Dim dbss As DAO.Database Dim tdf1 As TableDef Dim tdf As TableDef Dim fld, fld1 As Field Dim tbl, tbl1 As String tbl = "Table" tbl1 = "Tablex" Set dbs = CurrentDb Set dbss = CurrentDb Set tdf = dbs.TableDefs(tbl) Set tdf1 = dbss.TableDefs(tbl1) Set rst2 = dbs.OpenRecordset(tbl) Set rst = dbss.OpenRecordset(tbl1) rst.MoveLast If rst.Fields.Count <> rst2.Fields.Count Then GoTo dd If IsNull(rst.Fields(1)) Then GoTo dd For Each fld In tdf.Fields s = 0 For Each fld1 In tdf1.Fields If fld.Name = fld1.Name Then s = s + 1 Next fld1 If s = 0 Then GoTo dd Next fld Set dbss = Nothing Set dbs = Nothing rst.Close DoCmd.SetWarnings False DoCmd.OpenQuery "import_tbl" DoCmd.DeleteObject acTable, "Tablex" DoCmd.SetWarnings True txtImportFile = "" MsgBox "Data imported successfully" Exit_أمر8_Click: Exit Sub dd: rst.Close MsgBox "هناك اختلاف في اسماء الحقول " DoCmd.SetWarnings False DoCmd.DeleteObject acTable, "Tablex" DoCmd.SetWarnings True

استاذى الفاضل تحت الاعداد الان بامر الله خلال هذا الشهر سيتم نشر الموضوعين .

السلام عليكم ورحمة الله وبركاته .. أواصل معكم دروس مهارات في برنامج أكسس . ومع فكرة جديدة ومتميزة .. 😉 كيفية عمل رسائل إرشادية متحركة .. متابعة ممتعة أتمناها لكم 🌹 ولتحميل ملف التطبيق من هنا : درس رسائل إرشادية.accdb

Sub MyStuNames() On Error Resume Next Application.ScreenUpdating = False Set rng1 = Worksheets("StudNames"): Set rng2 = Worksheets("Analysis") S = Mid(rng2.[AB1], 1, Len(rng2.[AB1]) - 1) & "-" & Right(rng2.[AB1], 1): t = rng2.[AB1] S2 = Mid(rng2.[AB1], 1, Len(rng2.[AB1]) - 1) & "/" & Right(rng2.[AB1], 1): t2 = rng2.[AB1] X = Application.CountIf(rng1.Range("B:B"), S) + Application.CountIf(rng1.Range("B:B"), t) + Application.CountIf(rng1.Range("B:B"), S2) Y = IIf(Range("LangCod") = 2, 5, 4) rng2.Range("B8:C42") = Empty For i = 1 To X rng2.Cells(7 + i, "B").Value = i For Each cel In rng1.Range("B2:B5000") If (cel = S Or cel = t Or cel = t1) And cel.Offset(0, -1) = i Then _ rng2.Cells(7 + i, "C").Value = rng1.Cells(cel.Row, Y).Value Next Next Application.ScreenUpdating = True End Sub هكذا؟

نعم أخي العزيز .. يمكنك ذلك والمواضيع المطروحة في هذا المجال كثيرة .. خذ على سبيل المثال :

عذرا أخي فالبرنامج لم يعمل على جهازي أيضا لا أدري ما السبب بالضبط وهو يعمل على جهاز آخر بدون اشكال وهذا برنامج آخر أصغر حجما يقوم بنفس المهمة https://www.dropbox.com/s/c884etdhaotc592/FreeQRCreator.exe?dl=0

السلام عليكم بناء على طلب اخي الجزيرة مرفق الطريقة لعمل تقرير خلال فترة محددة اكتب فترة التواريخ المطلوبة من الى في الخلايا الصفراء يمين الشاشة حدد اسم السائق او رقم السيارة في الخلايا الصفراء اعلى الشاشة اضغط بحث2 تظهر النتائج ofcna3.rar