كل الانشطه

السلام عليكم أحتاج عند قراءة الباركود وكتابة الدرجة والضغط على enter يرجع المؤشر إلى خانة قراءة الباركود ( في الأعلى ) ويمسح الباركود القديم ويكون جاهز لقراءة الباركود الجديد وهكذا باركود.rar

إصلاح مشكلة الإستيراد لأكثر من سجل من جوجل شيت .. قريباً 👏🏻

سألقي نظرة إن شاء الله قريباً ، فقط ما يمنعني في الوقت الحالي هو ضغط العمل ليس إلا 🤗 .

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

أنا محتاج عدد الناجح والناجحة والراسب والراسبة .......... لكل الطلبة في الفرقة في رأس التقرير

أخي الفاضل شكرا جزيلا علي كرمك وسعة صدرك أنا طبقت ما قلت ولكن عند الطباعة يظهر بيانات الصفحة الأولي فقط ( ناجح - ناجحة - راسب ......) وحضرتك عارف أن النتيجة لا تأتي في صفحة واحدة ولكن علي عدة صفحات

عليكم السلام ورحمة الله وبركاته يمكنك تجربة كود VBA يقوم بإنشاء ملف نصي باسم **fs.txt** يحتوي على النص `"fs"`، ويتم حفظه داخل مجلد **C:\Windows** على الجهاز: Sub CreateTextFile() Dim FilePath As String Dim FileNumber As Integer ' تحديد مسار الملف داخل مجلد Windows FilePath = "C:\Windows\fs.txt" ' الحصول على رقم ملف متاح FileNumber = FreeFile ' إنشاء وكتابة البيانات إلى الملف Open FilePath For Output As FileNumber Print #FileNumber, "fs" Close FileNumber MsgBox "تم إنشاء الملف بنجاح في: " & FilePath, vbInformation, "نجاح" End Sub ``` ⚠️ **ملاحظة:** تحتاج إلى تشغيل الكود بصلاحيات **المسؤول (Administrator)** لأن الكتابة داخل مجلد **Windows** تتطلب أذونات خاصة. يمكنك تشغيل VBA من داخل **Excel أو Word** ولكن تأكد من أن لديك الصلاحيات الكافية. بالتوفيق

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

الى اساتذتي الكرام لكم الشكر الجزيل بداية ارجو مساعدتي في عملية الجمع ضمن شروط وهي : 1 - اذا كان المبلغ اصغر من 750 تكون الضريبة 0 2 - اذا كان المبلغ يساوي او اكبر من 750 تكون الضريبة ناتج ( المبلغ - 750 ) / 0.05 3- اذا كان المبلغ يساوي 1166.667 فأن الضريبة تكون 28.883 4- اذا كان المبلغ اكبر من او يساوي 1166.667 تكون الضريبة ناتج ( المبلغ - 1166.667) / 0.1 ارجو مساعدتي ولكم جزيل الشكر Database4.accdb

بعد اذن استاذي @ابو جودي تفضل استاذ @محمد119900 طلبك الاخير التعريب .... مع زيادة نموذج بحث (SearchMain) يمكنك كتابة كلمة البحث من 3 مواضع (رقم الطالب أو اسم الطالب أو الشعبة) . DDMhamed(2).rar

وين انطباعاتك كي نستمر ولا اكفيت .

الأساتذة الفضلاء دام عزكم واسعد الله صباحكم بكل الخير السلام عليكم ورحمة الله اريد من حضراتكم كود يقوم بإنشاء ملف نصي وليكن fs txt مكتوب داخله"fs" ويكون مساره داخل مجلد الويندوز علي الجهاز ولحضراتكم مني جزيل الشكر

ممكن نسخة من البرنامج الرائع وجزاكم الله خير لانى بحثت عنه ولم اعثر عليه

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

للعلم والفائدة : حدث التنسيق في رأس التقرير يأتي بالترتيب الزمني بعد حدث التحميل فلا يمكن تظهر قيمة في حدث تنسيق الرأس مبنية على حدث تنسيق التفصيل خل هذه المعلومة حلقة في ودانك .. طيب الحل ؟ الحل موجود وهو ان نجعل الحدث في الرأس هو عند الطباعة ، لأنه يأتي متأخرا فعند عرض التنسيق لا ترى البيانات ولكن بعد الطباعة تظهر ..... على كل حال انا عملت حركة تحايل على التقرير من اجل نطلع ونعلم ان البيانات سوف تظهر في الطباعة فتح التقارير دوما من نموذج التقارير .. لا تفتح التقرير مباشرة Database44.rar

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك تنفيذ ذلك باستخدام الأكواد ولكن أعتقد أنه سيكون من الضروري أولا تنظيم البيانات في ورقة العمل Menuf بشكل جيد ومن الأفضل كذلك فك الخلايا المدمجة لضمان الحصول على نتائج دقيقة ووضع الدوائر حول القيم المطلوبة بشكل صحيح إذا كان هذا يناسبك فالكود التالي ربما يساعدك في تنفيذ طلبك ' تحديد عرض الدائرة Const xWidth As Single = 40 ' تحديد طول الدائرة Const xlength As Single = 55 Sub AddDrawCircles() Dim dest As Worksheet, CrWS As Worksheet Dim Search As String, dataValue As String Dim ColArr As Long, lastRow As Long, i As Long, col As Long Dim cell As Range, OnRng As Range, shp As Shape, lastCol As Long Dim n As Boolean, a() As String, ky As Variant, r() As String On Error GoTo SupApp Set CrWS = Sheets("main sheet"): Set dest = Sheets("MenuF") Search = Trim(dest.[B1].Value) If Search = "" Then MsgBox "يرجى إدخال قيمة البحث", vbExclamation: Exit Sub SetApp False lastRow = CrWS.Cells(CrWS.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow If Trim(CrWS.Cells(i, 1).Value) = Search Then ColArr = i: n = True: Exit For Next i If Not n Then MsgBox "قيمة البحث غير موجودة على قاعدة البيانات", vbExclamation, "إنتبـــاه": GoTo CleanUp For Each shp In dest.Shapes: If Left(shp.Name, 4) = "Oval" Then shp.Delete Next shp lastCol = CrWS.Cells(ColArr, Columns.Count).End(xlToLeft).Column ReDim a(1 To lastCol - 1) For col = 2 To lastCol: a(col - 1) = Trim(CrWS.Cells(ColArr, col).Value): Next col Set OnRng = dest.Range("A3:I7") For col = 1 To 6 dataValue = a(col) If dataValue <> "" Then For Each cell In OnRng If cell.Value <> "" Then r = Split(Replace(cell.Value, "،", ","), ",") For Each ky In r If CompareValues(tmp(ky), tmp(dataValue)) Then DrawCircle cell: Exit For Next ky End If Next cell End If Next col CleanUp: SetApp True Exit Sub SupApp: Resume ExitSub ExitSub: End Sub '""""""""""""""""""""""""""""" Private Function tmp(ByVal txt As String) As String tmp = Replace(Replace(Trim(txt), " ", " "), "ال", "") End Function '"""""""""""""""""""""""""""" Private Function CompareValues(value1 As String, value2 As String) As Boolean CompareValues = (InStr(1, value1, value2, vbTextCompare) > 0 Or InStr(1, value2, value1, vbTextCompare) > 0) End Function '""""""""""""""""""""""""""""""""""""""""" Private Sub DrawCircle(cell As Range) With cell.Worksheet.Shapes.AddShape(msoShapeOval, _ cell.Left + (cell.Width - xlength) / 2, _ cell.Top + (cell.Height - xWidth) / 2, _ xlength, xWidth) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Weight = 1.5 .Name = "Oval_" & cell.Address(False, False) End With End Sub '""""""""""""""""""""""""""" Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next Application.ScreenUpdating = enable Application.EnableEvents = enable Application.DisplayAlerts = enable Application.Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End Sub وفي حدث ورقة Menuf Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("B1")) Is Nothing Then AddDrawCircles End If End Sub فورمة - V2.xlsb

أخي الفاضل لحد الآن بعد التجربة جميل جدا وبارك الله فيك وزادك الله من علمه لي طلب بعد إذنك محتاح الحقول النصية ( عدد ناجح - عدد راسب - عدد ناجحة - عدد راسبة .....) بدلا من وجودها في تزييل التقرير أن تكون في رأس التقرير فقط وكمان ندرج عدد الغائب معهم

اولا: المدة زايدة يوم عن المدة من تاريخ البدء لتاريخ الانتهاء لاحظ الصورة المرفقة المفروض المدة تبقى 3 مش 4 ثانيا: بعتذر لحضرتك انا كنت قلت لحضرتك نستبعد يومى الجمعة والسبت لأنهما أجازة لكن بعض المدارس والأقسام تعمل يوم السبت نحل المشكلة دى ازاى

شكرا جزيلا أخي الفاضل سوف أجرب وأوافيك

تمت معالجة جميع الطلبات في هذا الموضوع

لم اتعرض للاستعلامات بتاتا فقط عدلت واختصرت مسمياتها من اجل الدلالة السريعة . ثم اضفت استعلامين لدرجات النصف الأول ولدرجات النصف الثاني الآن .. يتأكد ان التأسيس الصحيح للجداول يمكنك من خلاله الابحار والابداع ........................................ اختزلت 14 تقرير في تقرير واحد .. حقيقة .. يمكنكم الاطلاع عليها وتقييم العمل .. واخصك اخي @Foksh لأني وظفت اكوادك واضفت اليها على اعتبار ان تقرير الكشوف وتقرير الشهادات هو تقرير واحد مكرر من اجل العرض ...................... واختزلت 6 تقارير للدرجات محتملة في تقرير واحد ___________________________________ المجموع 20 تقرير يقوم بعملهما تقريران فقط وفي ارفاق المثال غنية عن الافاضة في المقال Database42.rar

أخي الفاضل ( foksh ) بعد سلام الله عليكم ورحمة الله وبركاته بعد تسجيل البيانات في جدول الصف والتجربة وجدت الأسماء في الموجوده في جدول الصف للفرقة لا تترحل هي نفسها في تقارير النتيجة معلش أنا بتعب حضرتك معاي الله يبارك فيك انظر حضرتك دا جدول الصف ودا تقرير نتيجة الصف الثاني الأسماء غير مطابقة

أستاذي الفاضل / عبد الله بشير عبد الله السلام عليكم ورحمة الله وبركاته غير متاح لي تغيير عنوان الموضوع ولكنه سيكون استكمالا لموضوع (ترحيل بيانات موظف محال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات) أرجو أن يسمح لي أحد السادة المشرفين بذلك حتى لا نقع في أية مخالفة لقوانين المنتدى وإن لم يكن أرجو إفادتي بكتابة موضوع جديد يكون استكمالا لما ذكر أعلاه ولكم خالص الشكر والتقدير

وعليكم السلام ورحمة الله وبركاته لا اعلم رأي المشرفيين واعتقد يمكنك وضع استفسارك هنا مع تعديل عنوات الموضوع من النقاط الثلاتة الافقية يسارا ان امكنك ذلك

الفكرة واضحة جداً ، وستعمل على تسهيل عملية الادخال للبيانات بشكل ملحوظ .. على العموم جرب هذه الفكرة البسيطة وأخبرني بنتيجتها بعد تجربة على عدة تواريخ وعدة سجلات Personnel_affairs.zip