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

اتمنى ان اكون فهمت طلبك بالشكل الصحيح جرب هذا التعديل حسب شروطك طال الكود حبتين Private Const Nm As String = "مصروفات السيارات" Public N_Sh$ Public Sub Ali_Tr() Dim Sh As Worksheet Dim S As Worksheet Dim My_r As Range Dim Lr& Dim My_mx() As Variant Dim Ar_mx() As Variant Dim Ar As Variant Dim cn&, rwn& Dim Z, Nr Set S = Sheets(Nm) S.Cells.Clear For Each Sh In ThisWorkbook.Worksheets With Sh Select Case .Name Case Is = Nm, "كشف حساب", "تقارير" Case Else N_Sh = .Name Set Rn = .Range("B21:F26") With Rn For Z = 1 To .Rows.Count cn = 3 rwn = .Rows.Count ReDim Preserve My_mx(1 To rwn, 1 To cn) If .Cells(Z, 4).Value > 0 Then If i = rwn Then GoTo 1 i = i + 1 Ar = Array(Sh.[B14] & " " & Application.Text(Sh.[C14], "[$-C01]dddd"), _ Sh.[G14] & " " & Application.Text(Sh.[H14], "yyyy/mm/dd")) My_mx(i, 1) = CStr(.Cells(Z, 1)): My_mx(i, 2) = CStr(.Cells(Z, 4)) My_mx(i, 3) = CStr(.Cells(Z, 5)) End If 1 Next End With '================================================== Set Rng = .Range("B32:D36") With Rng For Nr = 1 To .Rows.Count cl = 3 rw = .Rows.Count ReDim Preserve Ar_mx(1 To rw, 1 To cl) If .Cells(Nr, 2).Value > 0 Then If ii = rw Then GoTo 0 ii = ii + 1 Ar_mx(ii, 1) = CStr(.Cells(Nr, 1)): Ar_mx(ii, 2) = CStr(.Cells(Nr, 2)) Ar_mx(ii, 3) = CStr(.Cells(Nr, 3)) End If 0 Next End With With S Lr = Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0).Row .Cells(Lr, 1).Resize(, 2) = Array(N_Sh, "مصروفات سيارة") .Range(.Cells(Lr + 1, 2).Address).Resize(, UBound(Ar) + 1) = Ar .Range(.Cells(Lr + 2, 2).Address).Resize(, 3) = Array("إسم المندوب", "مبلغ", "ملاحظات") .Range(.Cells(Lr + 3, 2).Address).Resize(UBound(My_mx, 1), UBound(My_mx, 2)) = My_mx Lrr = Cells(.Rows.Count, 2).End(xlUp).Offset(2, 0).Row .Cells(Lrr, 3) = "المصروفات الاخرى للسيارات" .Range(.Cells(Lrr + 1, 2).Address).Resize(, 3) = Array("الإسم", "قيمة المصروف", "ملاحظات") With .Range(.Cells(Lrr + 2, 2).Address) .Resize(UBound(Ar_mx, 1), UBound(Ar_mx, 2)) = Ar_mx Lrw = S.Cells(Rows.Count, 2).End(xlUp).Row With S.Range(S.Cells(Lrw, 1).Address).Resize(, 10) .Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone: .Borders(xlEdgeTop).LineStyle = xlNone With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0: .Color = RGB(255, 0, 0) .TintAndShade = 0: .Weight = xlThin End With End With End With End With Erase My_mx: i = 0: Erase Ar_mx: ii = 0 End Select End With Next End Sub

السلام عليكم --------------- واجهة المتابعة --------------- جرب المرفق اي ملاحظه او تعديل الى وقت اخر نكمل العمل واجهة التقارير تحياتي برنامج_Ali.rar

المرفق السابق به مشكله في زر الطباعه تم التعديل يومية مبيعات_Ali1.rar

السلام عليكم أخي الكريم تم عمل التعديلات التالية (1) أرقام العمال ستؤخذ أوتوماتيكيا من المجال Lab_NO لاداعي للقائمة المنسدلة (2) الفترة ستختارها مرة واحدة فقط (للعامل الأول) ثم ستنتقل أوتوماتيكيا لباقي العمال ، فلاداعي للقائمة المنسدلة لباقي العمال أيضا (3) من واقع فهمي للمعادلة في ملفك الأول ،فلن يتم حساب أي ساعات إلا إذا كانت الخلية E2 (أو مثيلاتها) تحتوي علي D أو U أو N فمثلا ستجد عمالا ليس لهم ساعات بعد تشغيل الكود لأن خليتهم التي مثل E2 تحتوي علي AS (4) تم تعديل الكود ليناسب طلباتك وشرط الــ N (5) توزيع الساعات سيأخذ وقتا (قد يصل لدقائق) لذلك جعلتها علي زر لكيلا تتعطل كلما دخلت للورقة تفضل المرفق TIME SHEET 120_2.rar