اذهب الي المحتوي
أوفيسنا

كل الانشطه

هذه الصفحة تحدث تلقائياً

  1. الساعة الأخيرة
  2. الأستاذ الفاضل Foksh لماذا لم ينجح الحل عندما نقلته امل الاطلاع مع الشكر والتقدير اختيار التاريخ.xlsm
  3. الأستاذ الفاضل Foksh ماشاء الله تبارك الله عليك بالفعل هذا هو المطلوب كل الشكر والتقدير لك جزاك الله خير
  4. Today
  5. اخي محمد شاهد الصورة عند ترحيل البيانات في السشن رقم 1 تم الترحيل ولكن مقابل اكواد اخري اما بانسبة بالمقصود باول سشن اريد ترحيل كل عمود سشن منفصل وليس دفعة واحدة بمعني ان المعلم الاول يضع الغياب في عمود سشن 1 ويت ترحيلة ثم السشن الثاني يضع المعلم اغياب ويم ترحيلة وبمعني اخر يجب ترحيل عمود السشن الموجود به بيانات او علامة غياب واسف لعدم التوضيح مسبقا
  6. أخي @جلال محمد الكود فعلا يتحقق من ثلاثة شروط التاريخ + الكود + رقم السشن بمعنى عند تحديد تاريخ معين يتم البحث عن مطابقة الكود في الورقتين وجلب بيانات عمود السشن المقابل لنفس الكود عند التحقق من وجوده الى الاعمدة الخاصة بكل سشن وفي نفس نطاق التاريخ المحدد أعتقد أن هذا ما جاء في طلبك سابقا ممكن توضح هذه النقطة لو سمحت هل تقصد أن يتم جلب قيمة اول سشن لكل معلم فقط عند العثور على اول كود وتجاهل الأكواد الموالية او ماذا؟
  7. بسيطة أخي الكريم ، الآن حسب ملفك المرفق ، جرب هذا التعديل :- Sub FokshCheckBox() Dim chk As CheckBox Dim rng As Range Dim rowNum As Long, colNum As Long Dim targetCell As Range On Error GoTo SafeExit Set chk = ActiveSheet.CheckBoxes(Application.Caller) If chk.TopLeftCell Is Nothing Then GoTo SafeExit Set rng = chk.TopLeftCell rowNum = rng.Row colNum = rng.Column Set targetCell = Cells(rowNum, colNum - 1) ' عدّل هنا : لتحديث الخلية اليمين = + 1 If chk.Value = xlOn Then If IsEmpty(targetCell.Value) Then targetCell.Value = Now End If ElseIf chk.Value = xlOff Then targetCell.ClearContents End If SafeExit: End Sub والتأكد من عدم وجود عناصر متشابهة في الإسم من الـ CheckBox ، وقم باستدعاء الماكرو لكل عنصر منهم .. * ملاحظة ، تستطيع التبديل بين الخلية اليمين أو اليسار التي سيتم عرض التاريخ و والوقت فيها على الملف كاملاً من خلال استبدال -1 بـ +1 فقط ، كما هو موضح في الكود . 222مربع اختيار يضيف التاريخ والوقت عند الاختيار.zip
  8. اشكرك استاذ Foksh اشكرك على التفاعل ولكن المشكلة ان لدي خانات في اعمدة مختلفة وهو محدد ب عامود A فقط وقد تم التعديل بالملف المرفق امل الاطلاع جزاك الله خير 222مربع اختيار يضيف التاريخ والوقت عند الاختيار.xlsm
  9. شكرا جزيلا استاذ محمد تسلم ايدك الكود يعمل بكل سهولة ولكن كان عندي ثلاث شروط للترحيل تحقق منها واحد وهو التاريخ يوجد شرطين تطابق عمود الكود وتطابق رقم السشن الذي يبدا برقم 1 الي 5 بمعني : عند دخول معلم الحصة الاولي عند الترحيل يتم ترحيل عمود الحصة الاولي فقط ... وهكذا وشكرا لحضرتك علي مجهودك ووقتك
  10. هلا والله ... والله اشتقنا للأسف انا لم أكن اعرف المطلوب وضعت الإجابة بناء على السؤال حلوه النماذج الجميله اللى بتغير الوانها دى👍 بس فكرتى احلى 🤪 هو كده غلاسه 😆🫣
  11. نعم صحيح ، هي كفكرة حلوة وتتيح لك التوسع في طريقة وتنسيق عرض الساعة ، حتى أني استخدمتها في برنامج نظام الطابور لعرض الساعة باللغتين ( عربي و انجليزي ) من خلال النقر على الساعة نفسها 😅
  12. السلام علكم و رحمة الله انا لله و انا اليه راجعون اللهم تقبله عندك فى منازل الصديقين و الشهداء و اجعله من المغفور لهم اللهم صبر اهله و محبيه يارب العالمين
  13. اللهم اغفر له وارحمه واجعله مثواه الجنة والهم أهله وذويه الصبر والسلوان
  14. فكرة صح وحلوة .. مع انها عادية .. لكن لم تخطر على بالي واعتقد انها الافضل حسب منهجي الذي اسير عليه .. بعيدا عن الدوال الخارجية ويبقى .. الاختيار والافضلية متاح للمصمم وحيث ان كود أخونا محمد ليس له تأثير على احداث عداد النموذج .. فــ الذي حصل اني بالأمس ارسلت التحديث الى العميل
  15. طيب كفكرة ممكن تعمل الساعة لحالها في نموذج فرعي وتعمل الحدث في النموذج الفرعي بدون ما يأثر على أحداث النموذج الرئيسي 🙂 Clock In Sub Form.accdb
  16. تفضل أخي ملفين الملف الأول: يقوم بطباعة أوراق العمل حسب ما تكتبه من نطاقات في كل رسالة تظهر الملف الثاني : ما عليك إلا كتابة نطاق طباعة كل صفحة في الخلية A1 و البرنامج يقوم بطباعتها ملاحظات: · إذا اختار المستخدم الطباعة، تطبع جميع الأوراق في دفعة واحدة. · إذا اختار حفظ PDF، تنسخ هذه الأوراق إلى مصنف مؤقت ثم يصدر إلى PDF. *عند التصدير بصيغة PDF اختر مجلد لحفظ ملف الطباعة فيه *أهم شيء تنسيق الصفحات و الهوامش حيث لاحظت أن بعض الصفحات تتم طباعتها على ورقتين لعدم ضبط المسافات و الحدود أيضا عند تغيير أسماء أوراق العمل في الملف الأول لابد أن تغيرها في الكود. طباعة اكثر من صفحة.xlsb طباعة اكثر من صفحة من خلال خلية.xlsb
  17. اللهم اغفر له وارحمه وعافه واعف عنه وأكرم نزله ووسع مدخله واغسله بالماء والثلج والبرد ونقه من الذنوب والخطايا كما ينقى الثوب الأبيض من الدنس اللهم ادخله فسيح جناتك يارب العالمين
  18. اللهم إرحمه برحمتك الواسعة ولكل الأصدقاء الراحلين بهذا المنتدى العظيم اللهم زد فى حسناتهم وتجاوز عن سيائتهم وأسكنهم فسيج جناتك رب العالمين لما قدموه من خبرات وأفكار تعليمية ومساعدة للزملاء ولا أنسى عماد الحسامى سبحان الله العظيم الكريم أفكارهم ودروسهم باقية لكل من يسأل اللهم إحفظ جميع الزملاء فى هذا الجروب وبارك لهم وزد فى حسناتهم
  19. اللهم اغفر له وارحمه وعافه واعف عنه وأكرم نزله ووسع مدخله واغسله بالماء والثلج والبرد ونقه من الذنوب والخطايا كما ينقى الثوب الأبيض من الدنس اللهم ادخله فسيح جناتك يارب العالمين مع النبيين والصديقين والشهداء والصالحين وحسن أولئك رفيقا
  20. اللهم اغفر له وارحمه وعافه واعف عنه وأكرم نزله ووسع مدخله واغسله بالماء والثلج والبرد ونقه من الذنوب والخطايا كما ينقى الثوب الأبيض من الدنس اللهم ادخله فسيح جناتك يارب العالمين مع النبيين والصديقين والشهداء والصالحين وحسن أولئك رفيقا
  21. نسأل أعضاء المنتدى قراءة الفاتحة على روح المرحوم عبدالبارى البنا أحد أعضاء المنتدى البارزين
  22. حسب ما فهمت انك عاوز تضيف كلمة الكل فى كل قائمة وهذا ما تم عموما قمت بتعديل على استعلام النموذج لتطبيق الفلتره ABDatabase.rar
  23. السلام عليكم استاذى العزيز Hegazee اولا شكرا لحضرتك لتعبك واهتمامك ثانيا عند وضع الكود ومحاولة التعديل انا اقوم ببعض الاخطاء التى تفسد الكود وهذا خطأى انا اعلم ذلك لذلك مرفق الان ملف ارجو من حضرتك تطبيق الكود عليه حتى اتعلم منه مالذى يجب ان اقوم بتغيره ولكي يعمل بصورة جيده واخيرا شكرا لحضرتك وجزاك الله عنى خيرا طباعة اكثر من صفحة.xlsb
  24. وعليكم السلام ورحمة الله وبركاته ,,, بعد عدة محاولات من خلال المعادلات ، وجدت أنه من الصعب عدم تحديث الخلايا الغير معنية بالإدراج ، لذا توجهت الى استخدام الماكرو التالي :- Sub FokshCheckBox() Dim chk As CheckBox Dim rng As Range Dim rowNum As Long For Each chk In ActiveSheet.CheckBoxes Set rng = chk.TopLeftCell rowNum = rng.Row If chk.Value = xlOn Then If IsEmpty(Cells(rowNum, "A").Value) Then Cells(rowNum, "A").Value = Now End If ElseIf chk.Value = xlOff Then Cells(rowNum, "A").ClearContents End If Next chk End Sub وعليه ، فيتم استدعائه في جميع الـ CheckBoxes التي لديك فقط ، دون ربط العناصر ببعضها .. ملفك بعد التعديل ، جرب وأخبرنا بالنتيجة مربع اختيار يضيف التاريخ والوقت عند الاختيار.zip
  25. وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Option Explicit Sub Transfer() Dim a As Long, b As Long, colMap(0 To 4) As Long, tmp(0 To 4) As Boolean Dim srcArr As Variant, destArr As Variant, dict As Object, i As Long, j As Long, f As Long, lr As Long Dim xDate As String, lastRow As Long, xName As String, c As Boolean, xCode As Boolean, Irow As Range, val Dim CrWS As Worksheet, Data As Worksheet Set CrWS = Sheets("Sheet2"): Set Data = Sheets("Sheet3") Set dict = CreateObject("Scripting.Dictionary") xDate = Format(CrWS.Range("D2").Value, "dd/mm/yyyy") If xDate = "" Then MsgBox "المرجوا تحديد التاريخ", vbInformation: Exit Sub With Data For a = 5 To .Cells(3, .Columns.Count).End(xlToLeft).Column If Format(.Cells(3, a).Value, "dd/mm/yyyy") = xDate Then f = a: Exit For End If Next If f = 0 Then MsgBox "لم يتم العثور على التاريخ", vbExclamation: Exit Sub Set Irow = .Columns("E:P").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows) lr = IIf(Irow Is Nothing Or Irow.row < 5, 5, Irow.row) .Range(.Cells(5, f), .Cells(lr, f + 4)).ClearContents End With lastRow = CrWS.Cells(CrWS.Rows.Count, "C").End(xlUp).row srcArr = CrWS.Range("C12:H" & lastRow).Value For i = 6 To Data.Cells(Data.Rows.Count, "D").End(xlUp).row If Not dict.exists(Data.Cells(i, "D").Value) Then dict(Data.Cells(i, "D").Value) = i End If Next For j = 0 To 4 xName = CrWS.Cells(10, 4 + j).Value For b = 0 To 4 If Data.Cells(4, f + b).Value = xName Then colMap(j) = f + b Exit For End If Next Next For i = 1 To UBound(srcArr, 1) If srcArr(i, 1) <> "" Then If dict.exists(srcArr(i, 1)) Then xCode = True For j = 1 To 5 val = srcArr(i, j + 1) If Not IsEmpty(val) Then c = True Data.Cells(dict(srcArr(i, 1)) + 5, colMap(j - 1)).Value = val If Not tmp(j - 1) Then Data.Cells(5, colMap(j - 1)).Value = CrWS.Cells(11, 3 + j).Value tmp(j - 1) = True End If End If Next End If End If Next Select Case True Case c: MsgBox "تم ترحيل البيانات بنجاح", vbInformation Case Not xCode: MsgBox "لم يتم العثور على أي أكواد مطابقة", vbExclamation Case Else: MsgBox "لا توجد بيانات لترحيلها", vbInformation End Select Book2 -v2.xlsb
  1. أظهر المزيد
×
×
  • اضف...

Important Information