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

جربي : Me.account.Undo

عطني فرصة لباكر لأن عندي عارض مهم . وطلبك محتاج تركيز .

البرنامج شغال عندي تمام..... ومش عارف انت عملت ايه أو عاوز تعمل ايه ؟؟؟

ارسل محاولتك ونشوف السبب .

Sub test() Dim Sh As Worksheet: Dim WS As Worksheet: Set WS = Worksheets("data") Dim I&, F As Range For Each Sh In ThisWorkbook.Worksheets If Sh.Name <> WS.Name Then Application.ScreenUpdating = False For I = 3 To WS.Range("E" & Rows.Count).End(xlUp).Row If WS.Cells(I, "E") = Sh.Name Then WS.Range("A2:E2").Copy Destination:=Sh.Range("A1") Set F = WS.Range(WS.Cells(I, 1), WS.Cells(I, 5)) F.Copy Destination:=Sh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) With Sh.Range("A2:E" & Sh.Range("A" & Rows.Count).End(xlUp).Row) .Interior.Color = xlNone: .EntireColumn.AutoFit End With End If Next I End If Next Sh Application.ScreenUpdating = True End Sub

تم اخي العزيز بالفعل @kkhalifa1960

زي اللي فات ولا في أفضل اجابة .

استاذي الغزيز @kkhalifa1960 جزاك الله كل خير في الدنيا والاخرة مش عارف اشكرك ازاي والله ونعم الاخ والمعلم

تفضل أخي حسب مافهمت والذي بالاستطاعة عمله الشرح والمرفق . test.rar

عليكم السلام تكرار الحصة المقررة في كل سجل لا معنى له حسابيا المفروض تكون في اول سجل في حقل الإضافة انظر هذا مثال بسيط لعملية اخراج الارصدة الحالية موجود عندي من قبل لاحظ ان الرصيد محله الاستعلام او التقرير وليس الجدول لانه متغير والذي يهمنا هو : نتيجة آخر عملية آمل ان تجد فائدة وتبني عملك على هذا التصور db1.mdb

تفضل المرفق بعد التعديل . مؤثرات-2.rar

طيب جربي المرفق هذا <><><><><> LABBB (2).accdb

في موضوع آخر هناك دوال لتأخذ تاريخين بداية ونهاية ثم ترجع المدة على شكل سنة شهر يوم أما هذه الدالة تأخذ أيام فقط وتحولها إلى سنة شهر يوم، وهنا الدالة تفترض أن تاريخ البداية دائما هو بداية دورة الـ 400 سنة مثل: 1، 401، 801، 1201، 1601، 2001 وهكذا. Function FixVal(inVal As Double, MinVal As Double, MaxVal As Double) As Double FixVal = inVal If inVal < MinVal Then FixVal = MinVal If inVal > MaxVal Then FixVal = MaxVal End Function Function Days2Period(ByVal Days As Long) As String Dim CurCal As VbCalendar Dim Gr2: Gr2 = Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365, 396) Dim yy As Long, mm As Integer, dd As Integer Dim Cyc400 As Long, Cyc100 As Long, Cyc004 As Long, Cyc001 As Long Dim mmDays As Double, Leap As Byte CurCal = Calendar Calendar = vbCalGreg Cyc400 = Fix(Days / 146097): Days = Days - Cyc400 * 146097 Cyc100 = FixVal(Fix(Days / 36524), 0, 3): Days = Days - Cyc100 * 36524 Cyc004 = FixVal(Fix(Days / 1461), 0, 24): Days = Days - Cyc004 * 1461 Cyc001 = FixVal(Fix(Days / 365), 0, 3): Days = Days - Cyc001 * 365 yy = Cyc400 * 400 + Cyc100 * 100 + Cyc004 * 4 + Cyc001 mm = FixVal(Round(Days / 29.5, 0), 0, 11) Leap = Day(DateSerial(yy + 1, 3, 0)) - 28 mmDays = Gr2(mm) + IIf(mm > 1, Leap, 0) Do While mmDays > Days mm = mm - 1 mmDays = Gr2(mm) + IIf(mm > 1, Leap, 0) Loop dd = Days - mmDays Days2Period = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00") Calendar = CurCal End Function Days_to_Year_Month_Day_01.xlsm

Sub tarheel() Dim ws As Worksheet, xx As Integer, lr As Integer, r As Integer Dim sh As Worksheet: Set sh = Sheets(1) For Each ws In ThisWorkbook.Worksheets xx = sh.Cells(32, 3).End(xlUp).Row Application.ScreenUpdating = False For r = 8 To xx If sh.Cells(r, 3).Value = ws.Name And sh.Cells(r, 3).Value <> Empty Then sh.Range(Cells(r, 3), sh.Cells(r, 5)).Copy ws.Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date ws.Range("b" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End If Next Next Application.CutCopyMode = False sh.Range("b8:e21").ClearContents Application.ScreenUpdating = True End Sub 'OR**************************** Sub test() Dim Sh As Worksheet Dim WS As Worksheet: Set WS = Sheets(1) Dim iRow As Long, Rng As Range For Each Sh In ThisWorkbook.Worksheets If Sh.Name <> WS.Name Then Application.ScreenUpdating = False For iRow = 8 To 32 If WS.Cells(iRow, "C") Like Sh.Name Then Set Rng = WS.Range(WS.Cells(iRow, 3), WS.Cells(iRow, 5)) Sh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = Date Sh.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(, 3).Value = Rng.Value WS.Range("B8:E21").ClearContents End If Next iRow End If Next Sh End Sub _نموذج جرد السيارات __مع الطباعة - نسخة للتعديل.xlsm

اخوي فؤاد .. الجدول مكان لحفظ البيانات المدخلة فقط .. رغم وجود الحقل المحسوب وما تفكر به لا يتم باستخدام الجدول فقط فلو اردنا عرض الارصدة فقط يمكننا استخدام الاستعلام ولو اردنا تثبيت الارصدة في الجدول حسب كل سجل كما تفكر .. يجب ان تستخدم النموذج لحصر السجلات واستخراج النتيجة ثم ادراجها في الحقل المناسب

تفضل أخي @فؤاد الدلوي محاولتي حسب طلبك وزيادة . بالشرح والمرفق . test-1(2).rar

عليكم السلام ضع اسئلتك هنا ستحصل على حلول عديدة وسريعة ان شاء الله

هكذا

تمام لما تختار الرقم 201201281 من الليست بكس سيفتح أي صورة من الاربعة ؟؟؟؟؟؟ ...... (لازم تعريف مسمي الصور بالجدول أو نزود جدول لأسماء الصور) . فهمتني !!!!!

واذا تريد النتيجة باليوم والشهر والسنة عدل الاستعلام الي nombre du mois: GetAgeMonthsDays([date d'entrée];[date de sorter])

تفضل أخي النتيجة بالاستعلام(Query1) . skil2024-1.rar

تفضل search.accdb

شاكر لتعبك ومجهودك محتاج يعرض صور الكود المسجل فقظ وفقا ImageShow بمعنى اخر لما اختار رقم 201201281 يظهر في الليست بوكس صوره فقط ولما اختار رقم 201401062 يظهر في الليست بوكس صوره فقط ولا يسجل اسماء الصور في الجدول