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

تفضل أخي محمود 🙂 قائمة منسدلة تسهل لك تحديد التواريخ لنموذج البحث.accdb

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) كنت قد بحثت في المنتدى 🔍 (هنا) عن برامج لعرض مواقيت الصلاة ، وقد وجدت الكثير من المواضيع الجميلة والأفكار النيرة في المنتدى لأساتذة وأخوة بذلوا جهداً لا يوصف في مشاركاتهم بهذا الموضوع ، وإلى حد ما أكثرهم قرباً لضبط الأوقات كانت هذه المشاركة . اليوم الفكرة مختلفة قليلاً في هذا المشروع المتواضع والذي لا يحتوي تعقيدات يصعب قراءتها أو التعامل معها في الأكواد . حيث اعتمدت وتوجهت إلى البساطة من حيث عند النقل والدمج ( إلى / في ) أي مشروع . الآن شرح بسيط لبعض تفاصيل المشروع التي سيتم الإعتماد عليها :- سي سيتم الإعتماد على خطوط الطول والعرض بعد إجراء بعض التعديلات على طريقة احتساب الأوقات . وقد تمت المقارنة مع موقع ( مواقيت الصلاة ) للوصول إلى أقل فارق - إن وُجِد - في المواقيت . سيتم الإعتماد على تقويم أم القرى في أحدى مشاركات أستاذنا @ابوخليل . سيتم اعتماد إظهار الوقت المتبقي لكل موعد صلاة في الشاشة الرئيسية أو المصغرة ( ستضاف لاحقاً ) . سيتم منح الحرية للمستخدم بنوع التذكير لوقت الصلاة ( إشعار برسالة تنبيه داخل البرنامج ، إشعار فوق شريط Taskbar ) . سيتم أيضاً منح الحرية للمستخدم باختيار صوت التنبيه ( أذان كامل ، تكبير ، .... إلخ ) . المزيد من الأمور ستأتي لاحقاً تباعاً في تطويرات وتحديثات جديدة إن شاء الله . صورة لواجهة البرنامج حالياً ، والذي أسميته في الوقت الحالي " صلوات " 🤗 ، ما لم يتم اختيار اسم آخر تم التعديل بتاريخ 01/06/2024 وذلك لاضافة المرفق النهائى Salatak.zip

بارك الله فيك أخي @Foksh قمت بتجربة الملف نعم .. جزاك الله عني خيرا

والله مش عارف اشكرك ازاي ربنا يبارك في عمرك ويزيدك من علمه وجعله في ميزان حسناتك

تفضل اخي @qathi ، هل هذا طلبك ؟؟ ScanPro.zip

اعتذر منك أخي الكريم @2saad ، فعلاً العنوان لا يدل على سؤالك وطلبك في المشاركة الثانية على العموم . هل هذا طلبك mas.zip

عندي هذا النموذج الرائع منذ سنوات واستخدمه في كل برامجي هو للامانة ليس من تصميمي اتوقع صممه الأخ الحبيب @ابو جودي اقدمه لكم هديه فهناك من يحتاجه بحث حسب تاريخ.accdb

ألف ألف مليون شكر الله يديم عليك الصحة

لقد لاحظت انك قمت بفتح موضوع جديد بالطلب الثاني خطوة جيدة لاكن يبدو اننا بحاجة لانهاء الموضوع الاول وغلقه للمررور للطلب الثاني بادن الله بعد معاينة بعض التعاليق التي قمت انت باظافتها على الكود لاحظت انك ترغب بجلب بيانات عمود الغرفة المحددة الى عمود الرصيد ورقة FORM2 كان بوسعنا فعل دالك لو حاولت شرح طلبك بشكل اكثر وضوحا على ما اعتقد وقبل المرور للطلب الثاني قم بتجربة الكود التالي ووافينا بالنتيجة .. Sub CopyData() '“Update the code Dim OneRng As Range, r As Range, rw As Long, lastrow As Long Dim srcWS As Worksheet: Set srcWS = Sheets("Data") Dim WS As Worksheet: Set WS = Worksheets("FORM2"): rCrit = WS.[G5] '“Adjust the formula to suit you Const iCnt As String = "=IFERROR(@NombreToArabe(E9),"""")" '“Room search scope Set r = srcWS.Range("A4:AH4").Find(rCrit) If IsEmpty(WS.[G5].Value) Then: Exit Sub rw = srcWS.Columns("A:AH").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row If Not r Is Nothing Then With srcWS '“Set range (starting cell 5 of target column) Set OneRng = .Range(.Cells(5, r.Column), .Cells(rw, r.Column)) If WorksheetFunction.CountA(OneRng) = 0 Then: _ MsgBox "لا تتوفر نتائج على" & " : " & rCrit, vbInformation, _ "Information :": Exit Sub End With Application.ScreenUpdating = False WS.Range("A9:F" & WS.Rows.Count).ClearContents With srcWS If .AutoFilterMode Then .AutoFilterMode = False End With '“Column headers With srcWS.Range("A4:AH4") .AutoFilter r.Column, "<>" '(1)“If the columns are not adjacent ' rngA = Split("A,B,C,D", ",") ' rngB = Split("A,B,C,D", ",") ' For i = LBound(rngA) To UBound(rngA) With srcWS '(2) '.Range(rngA(i) & "5:" & rngA(i) & rw).Copy ' WS.Range(rngB(i) & "9").PasteSpecial Paste:=xlPasteValues '“From column ("A") to ("D") .Range("A5:D" & rw).SpecialCells(xlCellTypeVisible).Copy WS.Range("A9").PasteSpecial Paste:=xlPasteValues 'Copy the target column data .Range(.Cells(5, r.Column), _ .Cells(rw, r.Column)).SpecialCells(xlCellTypeVisible).Copy WS.Range("E9").PasteSpecial Paste:=xlPasteValues End With '(3) Next i .AutoFilter End With With WS '“Add the formula to the column of numbers in writing ("F") lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row With WS.Range("F9:F" & lastrow) .Formula = [iCnt]: .Value = .Value End With End With End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub يمكنك تعديل الكود بما يناسبك DATA V2-1.xlsb

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

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

تم تحديث البرنامج

**وعليكم السلام ورحمة الله وبركاته** **إليك كيفية طباعة الصفحات التي تحتوي على بيانات فقط في Excel:** **الخطوات:** 1. **حدد نطاق البيانات:** حدد جميع الخلايا التي تحتوي على البيانات التي تريد طباعتها. 2. **انتقل إلى "ملف":** انقر فوق علامة التبويب "ملف" في الزاوية العلوية اليسرى. 3. **اختر "طباعة":** انقر فوق خيار "طباعة" في القائمة الموجودة على الجانب الأيسر. 4. **حدد "إعدادات":** انقر فوق الزر "إعدادات" الموجود في الجزء العلوي الأيمن من نافذة الطباعة. 5. **تبويب "الصفحة":** انقر فوق علامة التبويب "الصفحة" في نافذة "إعدادات الطباعة". 6. **إلغاء تحديد "طباعة الصفحات الفارغة":** قم بإلغاء تحديد مربع الاختيار "طباعة الصفحات الفارغة". 7. **انقر فوق "موافق":** انقر فوق الزر "موافق" لحفظ الإعدادات. 8. **طباعة:** انقر فوق الزر "طباعة" لطباعة النطاق المحدد من البيانات فقط. **الكود:** يمكنك أيضًا استخدام الكود التالي لطباعة الصفحات التي تحتوي على بيانات فقط: Sub PrintDataOnly() 'حدد نطاق البيانات Range("A1:D10").Select 'إعدادات الطباعة With ActiveSheet.PageSetup .PrintArea = Range("A1:D10").Address .PrintComments = False .PrintEmptyRows = False .PrintEmptyColumns = False End With 'طباعة النطاق المحدد ActiveSheet.PrintOut End Sub **ملاحظة:** * سيؤدي هذا الكود إلى طباعة نطاق البيانات المحدد "A1:D10" فقط. * يمكنك تعديل نطاق البيانات في الكود وفقًا لاحتياجاتك.

كده تمام

عليكم السلام تفضل اخي الكريم هذه التقارير جاهزة من تصميم الاستاذ جعفر اشكال للتقارير.mdb

وعليكم السلام ورحمة الله تعالى وبركاته جرب هل هدا ما تقصده Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim A As Range For Each A In Range("M3:P28") If Not IsError(A) Then Application.ScreenUpdating = False Application.EnableEvents = False If A.Interior.ColorIndex <> xlNone Then A.Offset(0, -9).Interior _ .ColorIndex = A.Interior.ColorIndex Else A.Offset(0, -9).Interior.ColorIndex = xlNone End If End If Next A Application.ScreenUpdating = True Application.EnableEvents = True End Sub Book1 V2.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته Sub CopyData() Dim srcWS As Variant, _ WS As Worksheet, _ r As Range, _ OneRng As Range, rCrit As String Set srcWS = Sheets("Data") Set WS = Sheets("FORM2"): rCrit = WS.[G5] Const iCnt As String = "=IFERROR(@NombreToArabe(E9),"""")" Set r = srcWS.Range("A4:AH4").Find(rCrit) Cpt = Array(2, 3, 4, 33) With Application .Calculation = xlCalculationManual .ScreenUpdating = False If IsEmpty(WS.[G5].Value) Then: Exit Sub rw = srcWS.Cells(srcWS.Rows.Count, "B").End(xlUp).Row If Not r Is Nothing Then With srcWS Set OneRng = .Range(.Cells(5, r.Column), .Cells(rw, r.Column)) If WorksheetFunction.CountA(OneRng) = 0 Then: _ MsgBox "لا تتوفر نتائج على" & " : " & rCrit, vbInformation: Exit Sub End With WS.Range("A9:F" & WS.Rows.Count).ClearContents a = srcWS.Range("A5:AH" & srcWS.[A65000].End(xlUp).Row) For i = 1 To UBound(a) If a(i, r.Column) <> "" Then WS.Cells(F + 9, 2).Resize(, 4) _ = Application.IfError(Application.Index(a, i, Cpt), "") F = F + 1 End If Next With WS lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row With WS.Range("F9:F" & lastRow) .Formula = [iCnt]: .Value = .Value With WS.Range("A9:A" & lastRow) .Value = Evaluate("ROW(" & .Address & ")-8") End With End With End With End If .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub تمت اظافته للملف المرفق بالتوفيق ....... DATA V2.xlsb

السلام عليكم ورحمه الله وبركاته تفضل اخي filter-function-excel.xlsb

وعليكم السلام ورحمة الله وبركاته تفضل أخي الكريم خصم من قيمة خلية.xlsx

تم تعديل البرنامج مع اضافة الباركود اسفل الورقة. *ملاحظة هامة* يتم تثبيت خطوط الباركود المرفقه مع البرنامج لكي يظهر الباركود بصورة صحيحة اسفل ورقة الاختبار برنامج طباعة الاختبارات تعديل نهائي٣.rar

السلام عليكم ورحمة الله وبركاته وبعد سنين من العمل في كود الأكسس ، لازلت الى الأمس القريب كنت اعاني من عدم حصولي على النتائج المطلوبة من الجدول (بدون مجموعة محاولات) ، اذا كان المعيار هو حقل تاريخ الى ان حصلت على الكود التالي ، والذي اصبح التعامل فيه مع التاريخ سهلا انا احفظ هذه الوحدة النمطية بإسم fDateFormat: Function DateFormat(varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And [Date_Field]=" & DateFormat(The_Date_Field)) ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function وطريقة استعمال الكود كالأمثلة التالية: a = dlookup("[some field]","some table","[id]=" & me.id & " And [Date_Field]=" & DateFormat(The_Date_Field)) او ("Select DISTINCT cen, [Date] From TTTT Where [Date]=" & DateFormat(Me.Idate)) او عدة طرق اخرى اليكم مثالين في البرنامج المرفق ، كيف ان الدالة DateFormat تعطيني نتائج صحيحة مباشرة ، بينما استخدام الطريقة التقليدية للتاريخ لا تعطيني النتيجة مباشرة: الجدول يحتوي على تاريخين ، 1-5-2015 و 2-5-2015 ، وهنا سنقوم بالتجربة على التاريخ 1-5-2015 (ويمكنكم استخدام التاريخ التاثي 2-5-2015) ، وللتأكد من نتائجنا ، عملنا استعلامين : و استخدام الكود في Recordset 1. مع استعمال الدالة DateFormate Set rst = CurrentDb.OpenRecordset("Select DISTINCT cen, [Date] From tbl_T Where [Date]=" & DateFormat(Me.idate)) rst.MoveLast: rst.MoveFirst RC1 = rst.RecordCount والنتيجة صحيحة ، كما تدل عليه نتيجة الاستعلام في الاسفل: 2. مع عدم استعمال الدالة DateFromat ، وانما استخدام الطريقة التقليدية للتاريخ: Set rst = CurrentDb.OpenRecordset("Select DISTINCT cen, [Date] From tbl_T Where [Date]=#" & Me.idate & "#") rst.MoveLast: rst.MoveFirst RC2 = rst.RecordCount والنتيجة خطأ ، كما تدل عليه نتيجة الاستعلام في الاسفل: استخدام الدالة Dcount 3. مع استعمال الدالة DateFormat RC3 = DCount("*", "tbl_T", "[Date]=" & DateFormat(Me.idate)) والنتيجة صحيحة ، كما تدل عليه نتيجة الاستعلام في الاسفل: 4. مع عدم استعمال الدالة DateFormat ، ، وانما استخدام الطريقة التقليدية للتاريخ: RC4 = DCount("*", "tbl_T", "[Date]=#" & Me.idate & "#") والنتيجة خطأ ، كما تدل عليه نتيجة الاستعلام في الاسفل: جعفر 84.DateFormat_Examples.mdb.zip