تمييز الخلية النشطة بأكثر من طريقة

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    FontSize = ActiveCell.Font.Size

    LargeSize = FontSize * 3

    Cells.Font.Size = FontSize

    ActiveCell.Font.Size = LargeSize

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'حدد الزوم او عدد تكبير الخلية

    ZoomCell 2

End Sub

Private Sub ZoomCell(ZoomIn As Single)

    Dim s As Range

    Set s = Selection

    'Get rid of any existing zoom pictures

    For Each p In ActiveSheet.Pictures

        If p.Name = "ZoomCell" Then

            p.Delete

            Exit For

        End If

    Next

    'Create a zoom picture

    s.CopyPicture Appearance:=xlScreen, _

      Format:=xlPicture

    ActiveSheet.Pictures.Paste.Select

    With Selection

        .Name = "ZoomCell"

        With .ShapeRange

            .ScaleWidth ZoomIn, msoFalse, _

              msoScaleFromTopLeft

            .ScaleHeight ZoomIn, msoFalse, _

              msoScaleFromTopLeft

            With .Fill

                .ForeColor.SchemeColor = 9

                .Visible = msoTrue

                .Solid

            End With

        End With

    End With

    s.Select

    Set s = Nothing

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.ScreenUpdating = False

    Cells.Interior.ColorIndex = 0

    Target.Interior.ColorIndex = 3

    Application.ScreenUpdating = True

End Sub

Private objCurrentCell As Range

Private OrigColorIdx As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Application.EnableEvents = False

    On Error Resume Next

    If objCurrentCell Is Nothing Then

        Set objCurrentCell = Target

        OrigColorIdx = Target.Interior.ColorIndex

        Target.Interior.ColorIndex = 3

    Else

        objCurrentCell.Interior.ColorIndex = OrigColorIdx

        Set objCurrentCell = Target

        OrigColorIdx = Target.Interior.ColorIndex

        Target.Interior.ColorIndex = 3

    End If

    Application.EnableEvents = True

End Sub