اضافة فقرة في الكود (عمل ترقيم بعد عملية الضغط على الزر)

[نبا زيد]

السلام عليكم

ممكن اضافة الى الكود عمل ترقيم بعد الضغط على زر التصفية 

وكما موضح بالملف

 

 

كود حذف وتنسيق وادراج.xlsm

تم تعديل نوفمبر 15 بواسطه نبا زيد

[نبا زيد]

السلام عليكم

 

[أبومروان]

وعليكم السلام ورحمه الله وبركاته 

ارجو ان يكون المطلوب

كود الترقيم 

Sub NumberRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
 
    Set ws = ThisWorkbook.Sheets("ورقة1")
    
 
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    
    For i = 2 To lastRow
        ws.Cells(i, "A").Value = i - 1
    Next i
End Sub

كود التصفيه بعد التعديل 

Sub DeleteRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim deleteCount As Long
    Dim response As VbMsgBoxResult
    
    Set ws = ThisWorkbook.Sheets("ورقة1")
    
    ' تحديث العمود الذي يتم حساب آخر صف فيه من A إلى B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    deleteCount = 0
   
    response = MsgBox("هل أنت متأكد أنك تريد حذف  من استلمو الاول والثاني", vbYesNo + vbQuestion, "تأكيد الحذف")
    
    If response = vbYes Then
        ' بدأ من الصف الأخير حتى الصف 3 كما في الكود الأصلي
        For i = lastRow To 3 Step -1
            ' العمل على العمود B و C للتحقق من وجود القيم قبل حذف الصف
            If ws.Cells(i, 2).Value <> "" And ws.Cells(i, 3).Value <> "" Then
                ws.Rows(i).Delete
                deleteCount = deleteCount + 1
             End If
        Next i
        MsgBox deleteCount & " صفوف تم حذفها.", vbInformation, "عملية الحذف"
    Else
        MsgBox "تم إلغاء عملية الحذف.", vbInformation, "إلغاء"
    End If


    ' تنسيق النصوص في النطاق B1:D50 بدلاً من A1:D50
    With ws.Range("B1:D50").Font ' تغيير النطاق ليشمل العمود B بدلاً من A
        .Name = "Arial"
        .Size = 16
        .Bold = True
        .Color = RGB(0, 0, 251) ' الأزرق
    End With

    ' إعداد الهوامش للطباعة
    With ActiveSheet.PageSetup
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
    End With

    ' كتابة التاريخ في العمود B (تم تحديثه من العمود A)
    ws.Range("B1").Value = Date - 1
    ws.Range("B1").NumberFormat = "dd/mm/yyyy"
    
    ' إزاحة التاريخ اليومي لكتابة اليوم في العمود A
    ws.Range("A1").Value = Format(Date - 1, "dddd")
NumberRows
End Sub

 

كود حذف وتنسيق وادراج (1).xlsm