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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاتة اهلا بكم اعضاء المنتدى الكرام اعتذر جدا للغياب الطويل عن المنتدى ولكن اشتقت اليكم فقولت ارجع بكود ممكن يفيد البعض فى عملة يعتبر البحث عن البيانات من الامور التى يبحث عنها كل مستخدمى الاكسل حيث انها تسهل عليهم اعمالهم وتحليل البيانات لديهم ولكن اذا كان لديك بيانات كثيرة جدا فى شيت الاكسل فالامر هنا يكون شاق ومرهق ومن هنا قررنا انشاء كود بحث من خلال اليوزرفورم يقوم بالبحث عن البيانات وتلوين واظهار نتائج البحث يتم وضع الكود فى حدث التكست بوكس 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

بسم الله الرحمن الرحيم السلام عليكم ورحمه الله وبركاته طبعا انا مسجل من فترة طويلة والصراحة منتدى مبدع واستفدت كثير وطرق كثيرة و استاذة كبار المنتدى حبيت اشارك بهذا الموضوع البسيط والكثير يبحث عنة وإن شاء الله اكون عند حسن الظن اخفاء الجداول و اظهارها على زر اظهار و اخفاء بكل بساطة ووضعت لكم الاكواد مع شرحها زر اخفاء الجداول اسم الزر ( HideTables ) كود الزر Dim db As DAO.Database Dim tbl As DAO.TableDef Set db = CurrentDb ' قم بتحديد الجداول التي ترغب في إخفائها ' يمكنك تكرار هذا السطر لإضافة المزيد من الجداول Set tbl = db.TableDefs("اسم_الجدول") ' قم بتعيين خاصية Hidden للجدول إلى True لإخفائه tbl.Attributes = dbHiddenObject ' أغلق قاعدة البيانات db.Close Set tbl = Nothing Set db = Nothing كود زر اظهار الجداول اسم الزر ( ShowTables ) Dim db As DAO.Database Dim tbl As DAO.TableDef Set db = CurrentDb ' قم بتحديد الجداول التي ترغب في إظهارها ' يمكنك تكرار هذا السطر لإضافة المزيد من الجداول Set tbl = db.TableDefs("اسم_الجدول") ' قم بتعيين خاصية Hidden للجدول إلى False لإظهاره tbl.Attributes = tbl.Attributes And Not dbHiddenObject ' أغلق قاعدة البيانات db.Close Set tbl = Nothing Set db = Nothing ودمتم سالمين باحطاب سوفت

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

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

عملت لك حل بالكود فصل الارقام عن الاحرف_01.xlsm

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

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

السلام عليكم و رحمة الله استخدم هذا الكود Sub Summing() Dim C As Range, i As Long Dim a As Integer, b As Integer i = 3 Do While i <= 4 a = Range("E" & i): b = Range("F" & i) For Each C In Range("A3:A9") If C.Value >= a And C.Value <= b Then k = k + C.Offset(0, 1) Range("G" & i) = k End If Next k = 0 i = i + 1 Loop End Sub

اداة لإستيراد جداول الإكسل و تصديرها معدلة لنسخ اخر بيانات.rar

تفضل تم اضافة الادارات والحاقها في التقارير ايضا يمكنك تصفية الادارات : حسب الادارة , وحسب التاريخ EvaluationEmpUp4.rar

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

ماذا تقصد بكاملة ؟ هل تقصد يظهر التقدير العام لكل شهر في سطر واحد ؟ ام تريد جميع بنود التقييم خلال 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

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) كثيراً منا حاول تشغيل تطبيقات ومشاريع آكسيس على الجوال ؛ ولكن دون نتيجة حقيقية أو فعالة . اليوم وبعد تجربة شخصية لتشغيل برامج آكسيس على الجوال بكل بساطة . دون مقدمات طويلة وعريضة لمبدأ بالمطلوب والأساسيات لتنفيذ هذه الفكرة . البرامج المطلوبة :- برنامج Limbo-x86 ؛ وهو البرنامج الوسيط لإنشاء جهاز كمبيوتر على الجوال . ويتم تثبيته على الجوال . ( APK ) نسخة Windows7 تم تثبيتها على الهاتف من نوع Huawei Y9s بمواصفات عادية ( ! ) . وتم تفعيل اللغة العربية بشكل كامل . ولم يتم حذف أي من مكوناتها . أيضاُ تم تثبيت نسخة أوفيس 2010 كاملة . ( QCOW2 ) برنامج ISO Craft-1.6 ، وسيتم ذكر وظيفته لاحقاً . أيضاً يتم تثبيته على الجوال ( APK ) طريقة العمل :- بعد نسخ الملفات التي تم تحميلها . يتم تثبيت التطبيق الأول Limbo-x86 وفتحه . لا بد من ضبطه بشكل بسيط كالآتي :- من النقاط الثلاثة أقصى اليمين نختار Settings . ثم نفعل الصلاحية للوصول لمدير الملفات ، وكذلك الأمر بالنسبة للـ Orientation نجعلها تساوي Landscape . كما في الصورة . ثم ننزل لأسفل عند الجزء Advanced ومنها الخيار High Priority نقوم بتفعيلها . ثم رجوع لواجهة البرنامج . الآن سنقوم بإنشاء جهاز كمبيوتر وهمي من خلال المثلث الصغير None ثم New ، ثم اكتب أي اسم تريده ( مثلاً Win7 ) . الآن سنقوم بضبط بعض الأمور ليعمل الجهاز الوهمي بأقل المواصفات ( حسب مواصفات الجوال ) . بالصور في الصورة التالية ، تستطيع تجربة أي الخيارات أفضل لك حسب نوع ومواصفات جهازك للتوضيح في هذا الجزء المهم . Machine Type & CPU Model & Enable MTTCG يجب تحديدهم كما هم بالصورة ( بعد عدة تجارب طبعاً ) الآن سنقوم بتحديد مسار نسخة الويندوز التي تم تحميلها ونسخها إلى ذاكرة الهاتف في Hard Disk A الآن بعد إتمام الإعدادات المطلوبة ، وقمنا بتشغيل الكمبيوتر الوهمي الذي تم إنشاءه . هذا الفيديو توضيحي للنسخة المرفقة في الروابط . طبعاً إجابةً لعدة استفسارات سيتم السؤال عنها وهي ( بطئ النسخة ، حجم الشاشة هل ستساعد ، الفكرة غير ناجحة لأسباب أخرى ما السبب ؟ .... ) كلها تعتمد على أن كرت الشاشة في التجربة هو السبب لأنه كرت شاشة وهمي ويعتمد على الذاكرة العشوائية للجوال . فعند تجربتي على جوالي الـ Huawei Y9s استغرق التشغيل والإقلاع الكامل تقريباً 6 دقائق ، بينما على جوال Samsung Note +10 استغرق التشغيل والإقلاع تقريباً 3 دقائق . ( ليست دعاية أو تسويق لأي منتج أو شركة ؛ وإنما توضيح للتجربة أين تم تطبيقها ) الآن نأتي لبرنامج ISO Craft-1.6 وما هي وظيفته وحاجته ؛ هذا البرنامج يستخدم لإنشاء ملفات الـ ISO على الجوال لإستخدامها كمحرك أقراص CD داخل البرنامج ونسخة الويندوز التي تم انشائها . وكتوضيح ؛ بما أن الويندوز الذي تم تشغيله مستقل بذاته عن الهاردوير ( القطع ) في الجوال فسنحتاج الى محرك أقراص وهمي ، وسيتم اختياره من هذا الخيار في البرنامج الرئيسي Limbo . أشكر لكم سعة صدركم إن كان الموضوع طويلاً . وإن فاتني نقطة لم ألتفت لها أرجو التنبيه بالتعليقات والمشاركات وسيتم العمل على التوسع في الفكرة بحيث تشمل الفكرة التطبيق على نسخة Windows 10 و أيضاً نسخة Windows XP

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

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

تم New Microsoft Access Database (1).accdb

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

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

اخي @أمير ادم قبل المتابعة معك ، لي مناقشة وعدة نقاط للإتفاق عليها . 1. حاول اختصار مسميات الجداول والنماذج والاستعلامات لتسهيل الأمور عليك. 2. لاحظت انك اعتمدت على الترقيم التلقائي لربط العلاقات بين الجداول في مشروعك وبالنسبة لي لا أعتقد أنها فكرة جيدة في المستقبل ، حاول اعتماد ترقيم خاص بالحركة و تكويد الاصناف .... إلخ والربط بينها بشكل صحيح في العلاقات . الآن بعد اجراء بعض التعديلات على ملفك ، إن كان ما قمت به صحيح سنتابع بناءً عليه في هذا المرفق ( TESTBOM.accdb ) . قم باختيار كود المنتج عصير مانجو مثلاً ، ثم قم بالتغيير لأي منتج آخر لنرى صحة العمل. وحاول أعانك الله إدراج تركيبة لمنتجات أخرى لتتوسع الفكرة وتتضح أكثر

حتى ينتقل المؤشر على نفس الحقل عند الضغط على انتر تجعل ال stop tab=yes والبقية تجعلها NO

معذرة .. ايقاف وليس الغاء انظر الصورة والابقاء على حقل الدرجة = نعم

جميلة الفكرة ، شكراً على الهدية 🤗

شكر وتقدير واحترام من اخيك

فعلا موضوع ممتاز

شكرا على الهدية و كل عام و أنت بخير

تفضل استاذ @2saad اليك المرفق بعد الاصلاح . ووافني بالرد . سعد-2 (AccessFIX).rar

فضّلك الله على خلقه وبارك فيك هوه هذا المطلوب

جزاك الله كل الخير 🤗 ولك من الدعاء نصيب أكبر 🤲

بارك الله فيك ورحم الله والديك ويجعل مثواهم الجنة

يمكنك جلب اول تاريخ استلام باستخدام المعادلة التالية فقط لاكن دون شرط الاسم بمعني اول تاريخ مدخل على الصف =IFERROR(INDEX(البيانات!B$1:M$1; MATCH(TRUE; INDEX(البيانات!B2:M2<>""; 0); 0));"لم يستلم") لهدا سنقوم بتعديل المعادلة بالشكل التالي لاظافة شرط الاسم الموجود في العمود A =IF(A2<>"";IFERROR(INDEX(البيانات!$1:$1;AGGREGATE(15;6;COLUMN(البيانات!$B$1:$M$1)/ (INDEX(البيانات!$B$2:$M$11;MATCH(A2;البيانات!$A$2:$A$11;0);0)<>"");1));"لم يستلم");"") الكود يشتغل عندي بشكل جيد لااعلم صراحة ما سبب عدم اشتغاله معك على العموم قم بتجربة الكود التالي بعد اظافة معادلة جلب اول تاريخ استلام في عمود D 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 '***جلب الاسماء من ورقة البيانات بدون تكرار مع تجاهل الفراغات***** Set Cpt = CreateObject("Scripting.Dictionary") a = Range(WS.[A2], WS.[a65000].End(xlUp)).Value For Each c In a Cpt(c) = "" Next c Set dest = desWS.[A2] desWS.Range("A2:D" & Rows.Count).ClearContents dest.Resize(Cpt.Count, 1) = Application.Transpose(Cpt.keys) ' ترتيب ابجدي dest.Resize(Cpt.Count, 1).Sort Key1:=dest, Order1:=xlAscending Set Cpt = Nothing lastrow = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lastcol = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column lige = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' نطاق البيانات Set a = WS.Range("B2:M" & lastrow): Set B = WS.Range("A2:A" & lastrow) ' رؤوس الاعمدة Set c = WS.Range("B1", WS.Cells(1, lastcol)) Set r = WS.Range("$1:$1") ' جلب اخر تاريخ استلام بشرط الاسم With desWS.Range("B2:B" & lige) .Formula = "=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 & "),""""),""لم يستلم"")" ' جلب مجموع قيم الصف بشرط الاسم With desWS.Range("C2:C" & lige) .Formula = "=IFERROR(SUM(INDEX('" & F & "'!" & a.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0)),"""")" ' جلب اول تاريخ استلام بشرط الاسم With desWS.Range("D2:D" & lige) .Formula = "=IF('" & desWS.Name & "'!A2<>"""",IFERROR(INDEX('" & F & "'!" & r.Address & ",AGGREGATE(15,6,COLUMN('" & F & "'!" & c.Address & ")/(INDEX('" & F & "'!" & a.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0)<>""""),1)),""لم يستلم""),"""")" ' Range("B2:D" & lige).Value = Range("B2:D" & lige).Value End With End With End With .ScreenUpdating = True .Calculation = xlAutomatic End With End Sub جلب اول واخر الاستلامات + المجموع.rar

اما انا ، فاحتفظ باستعلاماتي الاولية ، لأنه اذا استعلام التوحيد اعطى نتائج نريد التاكد منها ، فارجع الى استعلاماتي الاساسية ، ومنها تكون الصورة واضحة 🙂 جعفر

استعلام التوحيد لايمكن الاستغناء عنه في بعض مشاريعي اقوم بعمل الاستعلامات التي احتاج لاخراجها بشكل موحد ثم انسخ ال sql لها لكي اوحدها في استعلام واحد ثم امسح الاستعلامات طبعا تلك الطريقة غير احترافية ...المحترف يقوم بأنشاء استعلام توحيد مباشرة

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

وعليكم السلام ورحمة الله تعالى وبركاته لجلب اخر تاريخ استلام =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

اقرأ هذا الموضوع قد يفيدك ويعجبك 🥰

لكتابة مسار (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، سيتم فتح النموذج المحدد بناءً على الشفرة المعينة في الكود. تأكد من تعديل الأسماء والمسارات وفقًا لهيكل نموذجك واحتياجات برمجتك.

مشاركة مع الاخوان تفضل أخي @kams3008 مستخدماً موديول استاذ عبد القدوس . اليك الشرح والمرفق . Cnvert Date To Text.rar

هناك كود لإسترجاعها، ولكن الاسهل استعمال البرامج الجاهزة 🙂 جعفر

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