Excel Highlight Row And Column Of Active Cell

Excel VBA Highlight The Selected Cell

          ✜ When a cell is selected in sheet , Excel highlights the row and column with shapes by creating the background color and border of the associated row and column .

VBA codes to create shape on the selected cell:

Private Sub SekilYap()
Dim SatirCizgisi1 As Shape
Dim SutunCizgisi1 As Shape
Dim SatirCizgisi2 As Shape
Dim SutunCizgisi2 As Shape
Dim wR As Range

SutunDolguRengi = 44
SatirDolguRengi = 44
SatirDolgusuOlsunmu = msoTrue
SutunDolgusuOlsunmu = msoTrue
SatirSaydamligi = 0.8
SutunSaydamligi = 0.8
SatirCizgiRengi = 4
SutunCizgiRengi = 4
SatirCizgiKalinligi = 1
SutunCizgiKalinligi = 1

'Application.ScreenUpdating = False On Error Resume Next
Set SatirCizgisi1 = ActiveSheet.Shapes("SatirCizgisi1")
Set SutunCizgisi1 = ActiveSheet.Shapes("SutunCizgisi1")
Set SatirCizgisi2 = ActiveSheet.Shapes("SatirCizgisi2")
Set SutunCizgisi2 = ActiveSheet.Shapes("SutunCizgisi2")
Set wR = ActiveWindow.VisibleRange

If SatirCizgisi1 Is Nothing Then
Set SatirCizgisi1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, ActiveCell.Top, ActiveCell.Left, ActiveCell.Height)
With SatirCizgisi1
.Name = "SatirCizgisi1"
.Line.Weight = SatirCizgiKalinligi
.Line.ForeColor.SchemeColor = SatirCizgiRengi
.Fill.Solid
.Fill.Visible = SatirDolgusuOlsunmu
.Fill.Transparency = SatirSaydamligi
.Fill.ForeColor.SchemeColor = SatirDolguRengi 'fill.visible=msoTrue iken işe yarar, arka plan rengi
End With
End If
If SatirCizgisi2 Is Nothing Then
Set SatirCizgisi2 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Offset(0, 1).Left, ActiveCell.Top, ActiveSheet.Columns.Width - ActiveCell.Left, ActiveCell.Height)
With SatirCizgisi2
.Name = "SatirCizgisi2"
.Line.Weight = SatirCizgiKalinligi
.Line.ForeColor.SchemeColor = SatirCizgiRengi
.Fill.Solid
.Fill.Visible = SatirDolgusuOlsunmu
.Fill.Transparency = SatirSaydamligi
.Fill.ForeColor.SchemeColor = SatirDolguRengi
End With
End If
If SutunCizgisi1 Is Nothing Then
Set SutunCizgisi1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, 0, ActiveCell.Width, ActiveCell.Top)
With SutunCizgisi1
.Name = "SutunCizgisi1"
.Line.Weight = SutunCizgiKalinligi
.Line.ForeColor.SchemeColor = SutunCizgiRengi
.Fill.Solid
.Fill.Visible = SutunDolgusuOlsunmu
.Fill.Transparency = SutunSaydamligi
.Fill.ForeColor.SchemeColor = SutunDolguRengi
End With
End If
If SutunCizgisi2 Is Nothing Then
Set SutunCizgisi2 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Offset(1, 0).Top, ActiveCell.Width, ActiveSheet.Cells.Height - ActiveCell.Left)
With SutunCizgisi2
.Name = "SutunCizgisi2"
.Line.Weight = SutunCizgiKalinligi
.Line.ForeColor.SchemeColor = SutunCizgiRengi
.Fill.Solid
.Fill.Visible = SutunDolgusuOlsunmu
.Fill.Transparency = SutunSaydamligi
.Fill.ForeColor.SchemeColor = SutunDolguRengi
End With
End If

With SatirCizgisi1
.Left = 0
.Top = ActiveCell.Top
.Width = ActiveCell.Left
.Height = ActiveCell.Height
End With
With SatirCizgisi2
.Left = ActiveCell.Offset(0, 1).Left
.Top = ActiveCell.Top
.Width = ActiveSheet.Columns.Width - ActiveCell.Left
.Height = ActiveCell.Height
End With
With SutunCizgisi1
.Left = ActiveCell.Left
.Top = 0
.Width = ActiveCell.Width
.Height = ActiveCell.Top
If ActiveCell.Top > 169056 Then
.Top = ActiveCell.Top - 169056
End If
End With

With SutunCizgisi2
.Left = ActiveCell.Left
.Top = ActiveCell.Offset(1, 0).Top
.Width = ActiveCell.Width
.Height = ActiveSheet.Cells.Height - ActiveCell.Left
End With
Application.ScreenUpdating = True
End Sub