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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاتة اهلا بكم اعضاء المنتدى الكرام اعتذر جدا للغياب الطويل عن المنتدى ولكن اشتقت اليكم فقولت ارجع بكود ممكن يفيد البعض فى عملة يعتبر البحث عن البيانات من الامور التى يبحث عنها كل مستخدمى الاكسل حيث انها تسهل عليهم اعمالهم وتحليل البيانات لديهم ولكن اذا كان لديك بيانات كثيرة جدا فى شيت الاكسل فالامر هنا يكون شاق ومرهق ومن هنا قررنا انشاء كود بحث من خلال اليوزرفورم يقوم بالبحث عن البيانات وتلوين واظهار نتائج البحث يتم وضع الكود فى حدث التكست بوكس Dim Itemsaerch As String Dim rng As Range Dim cell As Range Dim lr As Long Sheet1.Cells.Interior.Pattern = xlNone Itemsaerch = Me.TextBox1.Value lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Set rng = Sheet1.Range("a2:a" & lr) For Each cell In rng If InStr(1, cell.Value, Itemsaerch) > 0 Then cell.Interior.Color = vbGreen End If Next cell If Me.TextBox1.Value = "" Then Sheet1.Cells.Interior.Pattern = xlNone ملف العمل فورم بحث جديد وتلوين نتائج البحث.xlsm

فى ظل امكاناتي المتواضعه وللحاجه وبعد مراجعة العديد من الحلول المتوفره على الويب التى لم اجد بها ضالتي اقدم لكم مربع التلوين هذا colorpicker حيث يقوم بتلوين خلفية النموذج بشرط تسميتها detail بالانجليزيه ورأس النموذج بشرط تسميته header وتذييل النموذج بشرط تسميته footer وكذلك مربعات التنسيق والتجميل rectangle بشرط ان يتم تسميتها box1 , box2 وهكذا وضعت وظائف التلوين فى حدث عند النقر المزدوج فى كل منها طبعا يمكن استخدام اسماء عناصر عربيه لكنها ستحتاج تعديل فى الجدول والكود ولا افضل ذلك المربعات الونيه يمكن تلوين حتى box9 اى تسع مربعات النموذج يحتوي اكثر من 400 لون معد سلفا منها 160 لون عشوائي تتغير بضغطة زر الى اخرى كل لون تختاره يمكنك التعديل عليه بتغيير قيم الالوان الاحمر والاخضر والازرق يوجد جزء خاص لضبط الخطوة فى + او - بقيم من 1 حتى 25 كما يوجد جزء خاص بتحديد سلوك تلوين الفورم فى المره القادمه التى سيفتح فيها وامامك 3 خيارات اما استخدام خياراتك الاخيرة للالوان واما استخدام الوان الجدول الافتراضيه وهى الوان رماديه يمكن تغييرها من الجدول فقط واما استعادة الوان الفورم عندما تم تصميمه ويتم التحكم فى كل جزء على حده اعلم انه بدائي لكنه يؤدي الغرض بفاعليه ونرحب بالافكار الجديده الكود متاح للجميع استخدامه شخصيا او تجاريا بشرط عدم ازاله شعار مؤسسة وعد الخيريه او كود الصوره اتمنى تزويدي بتعليقاتكم البرمجيه لتحسي الكود وتطويره لتعيين الصور كخلفيات يمكن التحميل من هنا mycolorpiker.zip

السلام عليكم كنت ابحث عن برنامج على جهازي الكمبيوتر بالصدفة وجدت هذا الملف الرائع احببت المشاركة معكم للفائدة اكواد كسس مهمة.rar

تفضل مسار المجلد.rar مسار الملف.rar

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) لكثرة الطلبات على برنامج إدارة الحضور والإنصراف للموظفين ، وددت مشاركتكم النسخة الأولى الغير مفتوحة المصدر حالياً ، لحين الإنتهاء من التعديلات التي ستتم على البرنامج . دون الإطالة في المقدمة ؛ سأشرح لكم بعض ميزات البرنامج :- أولاً سيتم إضافة الإعدادات الضرورية للبرنامج وهي :- تصنيف الموظفين ( ولكل تصنيف سيتم تحديد عدد أيام الإجازات السنوية له ) . تصنيف الإجازات ( طارئة ، مرضية ، ..... إلخ ) . تحديد وقت بداية ونهاية ساعات العمل الرسمي ، و تحديد مدة السماح للتأخير ( المرونة في العمل ) ، تحديد عدد مرات التأخير ليتم احتساب يوم إجازة في اليوم الأخير من المدة . ثانياً ومن الطبيعي وجود موظفين في قاعدة البيانات ، سيكون قسم لإدخال بيانات الموظفين بشكل بسيط من المعلومات ( ولكم حرية التوسع حسب رغبتكم وحاجتكم كمستخدمين ) ، وطبعاً لكل موظف رقم وظيفي خاص به اعتمد على سلسلة مكونة من التاريخ والوقت الحالي بدون مسافات بهذا التنسيق YYYYMMDDhhmmss ، بحيث لا يكون هناك تكرار نهائي لأي رقم موظف . ثالثاً لوحة تسجيل الحضور والإنصراف عن طريق الرقم الوظيفي ، وتدعم القراءة من الباركود الموجود على باجة الموظف ( طبعاً لاحقاً سيتم إضافة طباعة باجة أو بطاقة للموظف ) ، وفي هذه اللوحة لن تحتاج تحديد الحالة ( حضور أو إنصراف ) فقط أدخل رقم الموظف وسيتم احتساب وقت الحضور وتسجيل مدة التأخير بالدقيقة في الجدول ، وكذلك الأمر للإنصراف . رابعاً لوحة تسجيل الإجازات ، وطبعاً بناءً على المعطيات التي تم إدخالها في نماذج البيانات الأساسية في الإعدادات - سيكون الأمر بسيطاً جداً وتم اعتماد رقم الموظف في المرحلة الأولى من البرنامج وسيتم اعتماد اسم الموظف أيضاً لجلب البيانات لاحقاً . بخطوات بسيطة بعد ادخال رقم الموظف نحدد تاريخ بداية الإجازة ، ثم عدد الأيام المطلوبة كإجازة ، ثم سيتم تلقائياً احتساب يوم نهاية الإجازة ، وطبعاً نوع الإجازة المطلوبة ستقوم باختياره من قائمة نوع الإجازة . خامساً لوحة التقارير ، بحيث سيكون لدينا في المشروع تقرير واحد فقط لكنه سيخدم جميع الطرق التي تريدها كمستخدم ( تقرير للموظفين جميعاً مع وبدون تحديد فترة ، تقرير لموظف واحد مع وبدون تحديد فترة ) . *وطبعاً ما زالت قيد التطوير بشكل خاص ملاحظة:- تم حفظ البرنامج بصيغة Accde كونه قيد التطوير والتعديل حالياً اقترب عيد المسلمين مودعين به شهرهم الفضيل أعاده الله علينا وعليكم باليمن والبركات . وتقبل الله منا ومنكم الطاعات وصالح الأعمال . وسأختم به آخر تعديل على هذا المشروع البسيط ؛ متمنياً أن يكون على قدر الجهد المبذول فيه . وأعتذر بداية عن التأخير في انهاء العمل عليه ، ولكن لضيق الوقت ليس إلا . اليوم انهيت تأسيس الأساسيات في برنامج إدارة الحضور والإنصراف الذي يعمل بنظام بصمة الـ QR . وسأذكر بالتفصيل البسيط ما تم إضافته . الإضافات في النماذج :- ربط قارىء QR يعمل عن طريق الـ USB أو عن طريق الجوال بالنظام . دعم كامل لللغة العربية في قراءة رمز الإستجابة السريعة QR . اعتماد اسم الموظف بالإضافة الى رمز الـ QR . نظام التنبيه لضبط الإعدادات الرئيسية في البرنامج عند تشغيله أول مرة . إحصاء لعدد الموظفين ، الحضور ( على رأس عملهم ) ، المجازين ، المغادرات خلال اليوم . ترحيل بيانات الإجازات والمغادرات والحضور بشكل شهري ( بداية كل شهر ) . الإضافات في الأكواد :- تمت مراجعة جميع الأكواد من أي خطأ محتمل في التنظيم أو آلية العمل . تم إضافة فكرة تثبيت برنامج الربط Barcode2Win من خلال الأكواد ، وفي حال عدم وجوده يتم تحميله من الموقع الرسمي ( يتطلب انترنت ) . تم دمج العديد من الإستعلامات في الأكواد لتقليل مكونات وعناصر النظام وتخفيف العبئ عليه . تم تقسيم العديد من الوظائف لسهولة التعامل معها وصيانتها . تم إضافة نموذج لإعادة تهيئة النظام وتفريغ محتوياته ( الجداول ) ، طبعاً باسوورد تأكيد العملية مدمج في أكواد النموذج . العديد من المميزات التي ستجدونها في المشروع

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

اقدم لكم برنامج تحفيظ اسماء الله الحسنى للكبار والصغار مفتوح المصدر. . اليكم لينك المرفق . https://www.mediafire.com/file/1hrvf0h938769yq/GodNames.v1.1.rar/file

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

ومشاركة مع الأخوة والأساتذة:- Private Sub StudentName_BeforeUpdate(Cancel As Integer) If DCount("*", "Student_Tbl", "StudentName = '" & Me.StudentName & "'") > 0 Then MsgBox "اسم الطالب موجود بالفعل في الجدول.", vbExclamation, "تكرار الاسم" Cancel = True End If End Sub

مشاركة مع استاذي @عبد اللطيف سلوم تفضل استاذ @طير البحر محاولتي حسب مافهمت .اليك الشرح والمرفق . 1- مسار الصفحة بالفورم Forms!frm_Tab!TabCtl0.Value = 4 ' frm_Tab = اسم الفورم ' TabCtl0 =اسم التاب كنترول حيث 4= رقم الصفحة' 5 2- كيفية فتح الفورم على تاب محدد وليكن page5 (سويت لك 3 نماذج ) للتوضيح . DDTabcontrolPages.rar

اقدم لكم برنامج حساب أيام العمل أو الاجازات بين تاريخين .......... (اختيار أيام العمل الاسبوعية + العطل الرسمية) مفتوح المصدر. . اليكم المرفق . DDDayWork.rar

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

السلام عليكم أخواني وأساتذتي الكرام ، أقوم بعمل تجربة لمعرفة المعادلة الصحيحة لجعل النموذج يفتح في موضع معين . المطلوب من سيادتكم ارفاق لقطة شاشة فقط بالمكان الذي ذهب النموذج إليه . Test.accdb ولكم جزيل الشكر وبداية مني سأرفق صورة

ماذا تقصد بكاملة ؟ هل تقصد يظهر التقدير العام لكل شهر في سطر واحد ؟ ام تريد جميع بنود التقييم خلال 12 شهر اي 120 سطر ؟ على كل ارفع لك المرفق بعد اصلاح الخلل EvaluationEmpUp2.rar

السلام عليكم ورحمة الله تعالى وبركاته بعد ادن الاستاد @عبدالله بشير عبدالله اليك حل اخر ربما يناسبك هدا الكود لفلترة البيانات بين التواريخ ونسخها لورقة مخفية على نفس المصنف باسم printing Sub FilterByDate() Dim WS As Worksheet: Set WS = Worksheets("Sheet1") Dim desWS As Worksheet: Set desWS = Sheets("الانشطة") Dim f As Worksheet: Set f = printing Dim MinDate As Date, MaxDate As Date, lr As Long Dim a As Range, r As Long MinDate = desWS.[d2]: MaxDate = desWS.[f2] Application.ScreenUpdating = False If MinDate > MaxDate Then: Exit Sub If Len(desWS.[f2]) > 0 And IsDate(desWS.[d2]) Then If WS.AutoFilterMode Then WS.AutoFilterMode = False With WS.Range("A7:K7") .AutoFilter 3, ">=" & CLng(MinDate), 1, "<=" & CLng(MaxDate) lr = WS.Columns("A:K").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set rng = WS.Range("A" & lr & ":k" & lr).SpecialCells(xlCellTypeVisible) If WorksheetFunction.Subtotal(3, WS.Columns(3)) > 1 Then desWS.Range("A5:K" & Rows.Count).Clear With rng Cpt = Split("A,B,C,D,E,F,G,H,I,J,k", ",") Col = Split("A,B,C,D,E,F,G,H,I,J,k", ",") For i = LBound(Cpt) To UBound(Cpt) WS.Range(Cpt(i) & "8:" & Cpt(i) & lr).Copy desWS.Range(Col(i) & "5") Next i End With lige = desWS.Range("A:J").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Cpt1 = "=IF(c5="""","""",IF(c5=""Name"",""Count"",N(b4)+1))" Cpt2 = "=IF(ISBLANK(b5),"""",SUBTOTAL(3,B$5:B5))" With desWS .Range("B5:B" & lige).Formula = Cpt1: .Range("A5:A" & lige).Formula = Cpt2 .Range("A5:B" & lige).Value = .Range("A5:B" & lige).Value End With End If .AutoFilter End With f.Range("A2:K" & f.Rows.Count).Clear Set a = desWS.Range("A4", desWS.Range("A" & desWS.Rows.Count).End(xlUp)) For r = 1 To 11 Set a = Union(a, Intersect(a.EntireRow, Columns(r))) Next r a.Copy Destination:=f.Range("a2") End If Application.ScreenUpdating = True End Sub لحفظ الملف بصيغة PDF Sub Save_folder_PDF() Dim sFile As String, sPath As String, fPath As String Dim sMsg As String Dim desWS As Worksheet: Set desWS = Sheets("الانشطة") Dim f As Worksheet: Set f = printing sFile = "تقرير النشاط" folderName = "ملفات PDF" Application.ScreenUpdating = False Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير التقرير بصيغة", vbYesNo, f.Name) If Msg <> vbYes Then Exit Sub f.Visible = xlSheetVisible With ActiveWorkbook sPath = .path & Application.PathSeparator & folderName & Application.PathSeparator On Error Resume Next If Len(Dir(sPath, vbDirectory)) = 0 Then End If MkDir sPath f.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 f.ExportAsFixedFormat Type:=xlTypePDF, _ FileName:=sPath & Application.PathSeparator & sFile & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False f.Visible = xlSheetVeryHidden End With sMsg = "PDF" & " " & "تم حفظ التقرير بنجاح في مجلد " & "ملفات" MsgBox sMsg, vbExclamation, " من تاريخ: " & " " & desWS.[d2] & " " & "إلى تاريخ:" & " " & desWS.[f2] Application.ScreenUpdating = True End Sub لحفظ التقرير في ملف مستقل Sub Save_folder_Excel() Dim WS As Worksheet: Set WS = printing Dim desWS As Worksheet: Set desWS = Sheets("الانشطة") Dim path As String, folderName As String, sMsg As String Dim newWb As Workbook, Fname As String path = ThisWorkbook.path & "\" On Error Resume Next Msg = MsgBox("؟" & " " & "Excel " & ":" & " تصدير التقرير بصيغة", vbYesNo, WS.Name) If Msg <> vbYes Then Exit Sub With Application .ScreenUpdating = False .DisplayAlerts = False WS.Visible = xlSheetVisible folderName = "ملفات Excel" MkDir path & folderName Fname = folderName & "\" & WS.Name WS.Copy Set newWb = ActiveWorkbook newWb.SaveAs FileName:=path & Fname & ".xlsx", FileFormat:=51 newWb.Close WS.Visible = xlSheetVeryHidden .DisplayAlerts = True .ScreenUpdating = True End With On Error GoTo 0 sMsg = "Excel" & " " & "تم حفظ التقرير بنجاح في مجلد " & "ملفات" MsgBox sMsg, vbExclamation, " من تاريخ: " & " " & desWS.[d2] & " " & "إلى تاريخ:" & " " & desWS.[f2] End Sub فلترة وحفظ PDF +EXCEL.xlsm

السلام عليكم و رحمة الله استخدم هذا الكود Sub ReArrange() Dim Arr, Rtb, Tmp Dim WF As Object Dim x As Integer, i As Long, p As Long Set WF = WorksheetFunction Arr = Range("B2:C8").Value Rtb = Array("السابعة", "السادسة", "الخامسة", _ "الرابعة", "الثالثة", "الثانية", "الاولى") ReDim Tmp(1 To UBound(Arr, 1), 2) For i = LBound(Rtb) To UBound(Rtb) Tmp(i + 1, 1) = Replace(Arr(i + 1, 2), Arr(i + 1, 2), Rtb(i)) Tmp(i + 1, 0) = WF.Index(Range("B2:C8"), WF.Match(Rtb(i), _ Range("C2:C8"), 0), 1) Next Range("B2").Resize(UBound(Tmp, 1), 2).Value = Tmp End Sub

الاستاتذة الخبراء (kkhalifa1960 , و Foksh ) ابدعتم والله ابدعتم وتحياتي الخالصة لكم

شكرا جزيلا اخي الكريم Foksh فأنت في من يصدق فيهم قول الشاعر الناس من جهة التفضيل أكفاءُ … أبوهم آدم والأم حــــــــــــــــواءُ فإن لهمْ يكن من أصلهم شرفٌ … يفاخرون به فالطينُ والمـــــــاءُ وما الفخر إلا لأهل العلم إنهمُ… على الهدى لمن استهدى أدلاءُ وقيمة المرءِ ما قد كان يحسنهُ … والجاهلون لأهل العلمِ أعـــداءٌ فَعِشْ بعلمٍ تَفُـزْ حيَّاً به أبدا … الناسُ موتى وأهلُ العلمِ أحـــــــياءُ شكرا جزيلا فلقد اوضحت المشكلة واعطيت الحل و هذا هو كمال العطاء ومشاركة مني قمت برفع الملف بعد التعديل عليه وتحسين شكله قليلا لعل الله ينفع به أحدا من المسلمين. ملاحظة: الملف المرفوع للجداول فقط وسيتم اخر قريبا للجداول والاستعلامات Export_to_Excel الملف محدث وبشكل افضل.rar

أخي الكريم @2saad ، كل عام وأنت بخير بالنسبة لإنشاء تقارير من الاستعلامات هو يتميز بعدة نقاط منها :- المرونة : تستطيع استخدام الاستعلامات لتحديد البيانات التي تريد عرضها في التقرير بناءً على شروط محددة . التحكم في البيانات : أيضاً تستطيع استخدام الاستعلامات لتنفيذ العمليات الحسابية أو الوظائف المعقدة على البيانات قبل إدراجها في التقرير ، وبالطبع هذا يمكنك لمرونة أكبر في عرض البيانات. إعادة الاستخدام : بإمكانك استخدام نفس الاستعلام في تقارير متعددة إذا كانت تحتاج إلى عرض بيانات مماثلة. أما إنشاء تقارير مباشرة من الجداول فيتميز بعدة أمور منها :- البساطة و السرعة

مشاركة مع الأستاذ @محمد احمد لطفى Expr1: IIf([eltkeem_elam]="غ" And [stuehoa]="ذكر","ناجح بحكم القانون",IIf([eltkeem_elam]<>"غ" And [stuehoa]="ذكر","ناجح",IIf([eltkeem_elam]="غ" And [stuehoa]<>"ذكر","ناجحة بحكم القانون","ناجحة"))) ونرجو منك ان تساعد الأخوة في طريقة طرح السؤال والمعطيات في طلبك حتى تلقى الإجابة المطلوبة بسرعة من طرف الأساتذة . ناجح.accdb

استاذ @عبد اللطيف سلوم ايضاً موجود بمكتبتي .. من أعمال (الأستاذة زهرة العبدالله) .

السلام عليكم ورحمة الله وبركاته أسعد الله أوقاتكم بكل خير وسرور .. وتقبل الله منا ومنكم صالحات الأعمال .. 😊🤲🏻 يطيب لي أن أقدم لكم هذا الهدية المتواضعة بمناسبة هذا الشهر الفضيل 🙂🌼🎁 استبدل الرسائل العادية في أكسس برسائل ذات تصاميم قمة في الإبداع وبمميزات إضافية . من مميزات هذه الرسائل: - تصميم جميل وألوان جذابة. - خاصية ذاتية الاختفاء. - عنوان رئيسي + عنوان فرعي - تحكم بالنص ( عربي - إنجليزي ) ( توسيط - محاذاة على اليمين أو اليسار) - سهلة الاستخدام . الشرح على اليوتيوب : التحميل 🙂 Moosak MsgBox.accdb ولا تنسوني من صالح دعواتكم 😊🌷🌼🌹

تم New Microsoft Access Database (1).accdb

بناءا على طلب احد الاخوة المتابعين مثال بسيط على منع التكرار اتمنى من الاخوة الخبراء اثراء الموضوع ووضع طرق اخرى للفائدة منع تكرار الاسم.accdb

كبير يا عبداللطيف كبير ، وعلى راسي 🙂 سهله ، وخليني اعلمك كيف تصيد الخطأ 🙂 . Private Sub Form_Error(DataErr As Integer, Response As Integer) 'MsgBox DataErr If DataErr = 3022 Then Response = acDataErrContinue MsgBox "هذا الاسم موجود سابقا" End If End Sub 1602.Data_Exists.accdb

صحيح استاذ حاولت تغير اسم الموضوع الى (التعامل مع المجلدات في اكسس) لكني لم استطيع ارجو من ادرارة المنتدى تغييرة ليكون مرجع مفيد لمن يبحث عن موضوع مشابة

أخي @ازهر عبد العزيز ، لاحظ أن الموضوع قد تشعب لأكثر من سؤال . على العموم ضع هذا الكود في زر ، إذا كان المجلد فارغ سيتم حذفه بدون رسالة . أما اذا كان المجلد غير فارغ فسيتم التنبيه بأن المجلد غير فارغ قبل الاستمرار بالحذف . Dim FolderA As String Dim FolderPath As String FolderA = BookName.Value FolderPath = CurrentProject.Path & "\Library1\BOOKS\" & FolderA If Len(Dir(FolderPath, vbDirectory)) > 0 Then If Dir(FolderPath & "\", vbNormal) <> "" Then Dim Response As VbMsgBoxResult Response = MsgBox("هل ترغب في حذف المجلد ومحتوياته؟", vbQuestion + vbYesNo) If Response = vbYes Then Kill FolderPath & "\*.*" RmDir FolderPath End If Else RmDir FolderPath End If Else MsgBox "المجلد غير موجود", vbExclamation End If

مشاركة مع اخواني تفضل استاذ @ازهر عبد العزيز محاولتي . Libraries.rar

وعليكم السلام 🙂 مثل ما يقول المثل: اشلك بالبحر وأهواله و رزق اللَّه على السيف 🙂 وبدون كود: في جدول "الطالب" ، اجعل حقل "اسم_الطالب" : مفهرس (لا يقبل التكرار) 🙂 جعفر

بناء على استعلامات أخي @عبد اللطيف سلوم ، فكرتك كانت في 3 استعلامات منفصلة ، وخطر ببالي استعلام توحيدي واحد يجمعهم معاً لتحقيق الهدف . SELECT emp.[no], emp.[full-name], hol.[year-study], hol.namecours1 AS cours_name, hol.yearcours1 AS cours_year FROM emp INNER JOIN hol ON emp.[no] = hol.[no] WHERE hol.yearcours1 Is Not Null UNION ALL SELECT emp.[no], emp.[full-name], hol.[year-study], hol.namecours2 AS cours_name, hol.yearcours2 AS cours_year FROM emp INNER JOIN hol ON emp.[no] = hol.[no] WHERE hol.yearcours2 Is Not Null UNION ALL SELECT emp.[no], emp.[full-name], hol.[year-study], hol.namecours3 AS cours_name, hol.yearcours3 AS cours_year FROM emp INNER JOIN hol ON emp.[no] = hol.[no] WHERE hol.yearcours3 Is Not Null;

أخي لو لم تتم التجربة لما ارفقت الملف لك تفضل ، Dim FolderA As String FolderA = BookName.Value If Len(Dir(CurrentProject.Path & "\Libraries\Library1\BOOKS\" & FolderA, vbDirectory)) > 0 Then Shell "explorer.exe """ & CurrentProject.Path & "\Libraries\Library1\BOOKS\" & FolderA & """", vbNormalFocus Else MsgBox "المجلد غير موجود", vbExclamation End If ضع هذا الكود في أي زر أو حدث تريده

وهذه مشاركتي مع الأستاذ @عبد اللطيف سلوم . تم بناء استعلام توحيد وبناءً ، وتم بناء التقريرين عليه . الأول حسب المدرس ، والثاني حسب السنة Stu.accdb

😅 حاااضر ، تفضل هذا الملف مع التعديل بناءً على طلبك . CreateFolder.accdb

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

تفضل MkDir CurrentProject.Path & "\Libraries\Library1\BOOKS\" & FolderA

بسيطة اخي @ازهر عبد العزيز جرب هذا التعديل ، تقدر تستخدم المديول في أي مكان وفي اي نموذج 🤗 باستخدام كود الدالة التالي :- Public Sub CreateDataFolder() On Error Resume Next Dim FolderA As String Dim FolderB As String Dim FolderC As String Dim FolderD As String Dim FormsName As String FolderA = "Libraries" FolderB = "Library1" FolderC = "BOOKS" FormsName = frm.Name FolderD = Forms(frm).Controls("BookName").Value If Len(Dir(FolderA, vbDirectory)) = 0 Then MkDir CurrentProject.Path & "\" & FolderA If Len(Dir(FolderB, vbDirectory)) = 0 Then MkDir CurrentProject.Path & "\Libraries\" & FolderB If Len(Dir(FolderC, vbDirectory)) = 0 Then MkDir CurrentProject.Path & "\Libraries\Library1\" & FolderC If Len(Dir(FolderD, vbDirectory)) = 0 Then MkDir CurrentProject.Path & "\Libraries\Library1\BOOKS\" & FolderD End If End If End If End If End Sub Libraries.accdb

هناك طريقتان أخريان اعرفها If DCount("*", "الطالب", "اسم_الطالب='" & Me.xxx & "'") > 1 Then MsgBox "اسم الطالب هذا قد تم تسجيله من قبل." DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True End If Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT * FROM الطالب WHERE اسم_الطالب='" & Me.xxx & "'") If Not rs.EOF Then MsgBox "اسم الطالب هذا قد تم تسجيله من قبل." DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True End If rs.Close Set rs = Nothing

If DCount("*", "ÇáØÇáÈ", "ÇÓã_ÇáØÇáÈ = '" & Me.xxx & "'") <> 0 Then Call Undo MsgBox "ÇÓã ÇáßÊÇÈ ãæÌæÏ ÓÇÈÞÇ" DoCmd.CancelEvent If DCount("*", "ÇáØÇáÈ", "ÇÓã_ÇáØÇáÈ = '" & Me.xxx & "'") <> 0 Then Call Undo MsgBox "ÇÓã ÇáßÊÇÈ ãæÌæÏ ÓÇÈÞÇ" DoCmd.CancelEvent منع تكرار الاسم.accdb

وعليكم السلام ورحمة الله تعالى وبركاته لجلب اخر تاريخ استلام =IFERROR(IF(NOT(ISBLANK(A2));LOOKUP(2;1/INDEX(البيانات!$B$2:$M$11;MATCH(A2;البيانات!$A$2:$A$11;0);0) ;البيانات!$B$1:$M$1);"");"لم يستلم") لجلب المبلغ الكلي =IFERROR(SUM(INDEX(البيانات!$B$2:$M$11;MATCH(A2;البيانات!$A$2:$A$11;0);0));"") لجلب اخر قيمة مدخلة =IFERROR(LOOKUP(2;1/INDEX(البيانات!$B$2:$M$11;MATCH(الخلاصة!A2;البيانات!$A$2:$A$11;0);0);البيانات!B2:M2);"لم يستلم") في حالة الرغبة باستخدام الاكواد Sub test() Dim lastrow As Long, lige As Long, lastcol As Long Dim WS As Worksheet: Set WS = Sheets("البيانات") Dim desWS As Worksheet: Set desWS = Sheets("الخلاصة") With Application .ScreenUpdating = False .Calculation = xlManual F = WS.Name lastrow = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lastcol = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Set A = WS.Range("B2:M" & lastrow): Set B = WS.Range("A2:A" & lastrow) Set C = WS.Range("B1", WS.Cells(1, lastcol)) lige = desWS.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row desWS.Range("B2:C" & lige).ClearContents With desWS.Range("B2:B" & lige) .Formula2 = "=IFERROR(IF(NOT(ISBLANK('" & desWS.Name & "'!A2)),LOOKUP(2,1/INDEX('" & F & "'!" & A.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0),'" & F & "'!" & C.Address & "),""""),""لم يستلم"")" .Value = .Value With desWS.Range("C2:C" & lige) .Formula2 = "=IFERROR(SUM(INDEX('" & F & "'!" & A.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0)),"""")" .Value = .Value End With End With .ScreenUpdating = True .Calculation = xlAutomatic End With End Sub بالتوفيق........... التاريخ الاخير الذي استلم Formula.xlsx التاريخ الاخير الذي استلم VBA.xlsb

برنامج لتسجيل درجات الطلاب مع ترحيل الطلاب الناجحين الترحيل.rar

كل عام وانت بخير استاذ @عبد اللطيف سلوم صحيح ان ال chat GPT قفزة نوعية في عالم التكنولوجيا ..لكنه سينهي حب التعلم والابداع والبحث عن المعرفة نعم استخدمته في بعض الاحيان ...لكنني فكرت بأني سأصبح عبارة عن جماد لايفكر ... شخصيا ...افضل شي عندي تعلم البرمجة من اساتذتي في موقع اوفيسنا ...و طبعا من بعض المواقع الاجنبية الرائعة

لكتابة مسار (Path) لـ TabControl في صفحة محددة تحتوي على برمجة Access (Access programming)، يمكنك اتباع الخطوات التالية باستخدام لغة البرمجة VBA (Visual Basic for Applications): فتح محرر الفبات الخاص بالنموذج (Form): انقر نقرًا مزدوجًا على نموذج الواجهة الذي تريد العمل عليه. انتقال إلى وضع التصميم (Design Mode): تأكد من أنك في وضع التصميم لنموذج الواجهة. إضافة TabControl (التاب كونترول): إذا لم يكن TabControl مضافًا بالفعل، يمكنك إضافته من شريط الأدوات (Toolbox) عبر سحبه وإسقاطه على النموذج. تعيين مسار للتاب المحدد: حدد التاب الذي تريد تعيين مسار له في TabControl. انقر مرتين على التاب المحدد للانتقال إلى محرر الفبات الخاص به. إضافة الكود للتاب المحدد: انقر مرتين على التاب لتفعيل حدثه الافتراضي (العادة هو الحدث OnClick أو OnChange). أضف الكود الخاص بك في محرر الفبات. مثال بسيط لتعيين مسار لتاب محدد في VBA: Private Sub TabControlName_Change() Select Case TabControlName.Value Case 0 ' المسار الخاص بالتاب الأول DoCmd.OpenForm "Form1" Case 1 ' المسار الخاص بالتاب الثاني DoCmd.OpenForm "Form2" Case Else ' يمكنك إضافة المسارات الأخرى هنا حسب الحاجة End Select End Sub Private Sub TabControlName_Change() Select Case TabControlName.Value Case 0 ' المسار الخاص بالتاب الأول DoCmd.OpenForm "Form1" Case 1 ' المسار الخاص بالتاب الثاني DoCmd.OpenForm "Form2" Case Else ' يمكنك إضافة المسارات الأخرى هنا حسب الحاجة End Select End Sub TabControlName هو اسم TabControl الخاص بك. Case 0, Case 1 تمثل محتوى كل تاب (أول تاب، ثاني تاب، إلخ). DoCmd.OpenForm "FormName" تفتح النموذج المعين عند تحديد التاب المناسب. يرجى استبدال "Form1" و "Form2" بأسماء النماذج الفعلية التي تريد فتحها عند تحديد كل تاب. كما يمكنك إضافة المزيد من الحالات (Cases) حسب عدد التابات والمسارات التي تحتاجها. بعد إضافة هذا الكود، عند تغيير التاب في TabControl، سيتم فتح النموذج المحدد بناءً على الشفرة المعينة في الكود. تأكد من تعديل الأسماء والمسارات وفقًا لهيكل نموذجك واحتياجات برمجتك.

إذا لم تتابع فكيف نعرف حصلت على الحل أم لا!! احتمال آخر للحل إذا كان فهمي لمطلبك صحيحا: طول الشهر 20 يوم_02.xlsm

اقدم لكم برنامج مطعم كلاسيكي مفتوح المصدر. به بعض الكودات من أعمال بعض المنتسبين بمنتدانا (أفسينا)..... (به 33 طاولة طعام + دليفري + تيك أواي) ....والمهتم سيكتشف مابه ....... وأي استفسار أنا حاضر . اليكم لينك المرفق . https://www.mediafire.com/file/j0qasl6mlv1ju3x/CoffeShop.rar/file

تفضل استاذ @abouelhassan محاولتي حسب مافهمت .ووافني بالرد. Screen Saver With Form Idle.rar

السلام عليكم نفضل أحي التاريخ كتابة .accdb

وجدت هذا الملف في مكتبتي ..لكنه باللغة الانجليزية عسى ان ينفعك text date.rar

تفضل أخي قاعدة من تصميم أحد عمالقة المنتدى ومسامحة لم أتذكر الاسم . يعمل لدي بكفاءة ولايوجد به أخطاء . Backup.rar

السلام عليكم ورحمة الله وبركاته وبها نبدأ تأكد من انه لا يوجد مشكله في اعدادات اللغه العربيه في الجهاز لان الكود (الرئيسيه) ليس به مشكله