كود تلوين أطر الخلايا

[m_127899]

Sub colorCells()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim i As Long
    Dim j As Long
    
    Set ws = ActiveSheet ' تعيين الصفحة المفتوحة كـ ws
    
    ' تحديد عدد الصفوف والأعمدة في الصفحة
    lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastColumn = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    ' تكرار الصفوف والأعمدة وتحديد اللون الذي تريده لكل خلية
    For i = 1 To lastRow
        For j = 1 To lastColumn
            Select Case j ' يمكنك تغيير هذه الأرقام والألوان لتناسب احتياجاتك
                Case 1
                    ws.Cells(i, j).Borders.LineStyle = xlContinuous
                    ws.Cells(i, j).Borders.Color = RGB(255, 0, 0) ' اللون الأحمر
                Case 2
                    ws.Cells(i, j).Borders.LineStyle = xlContinuous
                    ws.Cells(i, j).Borders.Color = RGB(255, 255, 0) ' اللون الأصفر
                Case 3
                    ws.Cells(i, j).Borders.LineStyle = xlContinuous
                    ws.Cells(i, j).Borders.Color = RGB(0, 255, 0) ' اللون الأخضر
                Case 4
                    ws.Cells(i, j).Borders.LineStyle = xlContinuous
                    ws.Cells(i, j).Borders.Color = RGB(0, 0, 255) ' اللون الأزرق
                Case 5
                    ws.Cells(i, j).Borders.LineStyle = xlContinuous
                    ws.Cells(i, j).Borders.Color = RGB(255, 0, 255) ' اللون الأرجواني
                Case 6
                    ws.Cells(i, j).Borders.LineStyle = xlContinuous
                    ws.Cells(i, j).Borders.Color = RGB(0, 255, 255) ' اللون الأزرق الفاتح
            End Select
        Next j
    Next i
End Sub

 

[أبومروان]