Highlight cho dòng khi di chuyển trỏ chuột đến dòng đó (1 người xem)

[dangphongpro2010]

Chào mọi người,
Cho em hỏi có thể tạo highlight cho 1 dòng khi di chuyển trỏ đến dòng đó, và khi di chuyển trỏ chuột đến dòng khác, thì vị trí cũ sẽ trở lại bình thường như trước (vẫn giữ nguyên cách định dạng cũ) Em xin cảm ơn.

 

[Hong.Van]

ko được lun Bạn ơi, mình có đánh dấu định dạng nội dung bên trong nữa, nhưng chạy nó mất hết.hic..Bạn chỉnh lại giúp mình nhe. Cam ơn.

Thêm 1 lựa chọn cho bạn
Khi nào cần Highlight thì đánh dấu vào Check box "Highlight", còn kg cần thì bỏ dấu Check box

 

[ndu96081631]

Thêm 1 lựa chọn cho bạn
Khi nào cần Highlight thì đánh dấu vào Check box "Highlight", còn kg cần thì bỏ dấu Check box

Tôi thấy trong file có code thế này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If CheckBox21 = False Then Exit Sub
    Cells.FormatConditions.Delete
    ActiveCell.EntireRow.FormatConditions.Add 2, , [COLOR=#0000cd]abc[/COLOR]
    ActiveCell.EntireRow.FormatConditions(1).Interior.ColorIndex = 8
End Sub
[COLOR=#ff0000]Private Function abc() As String
    Dim arr(), i As Long
    arr = Array(61, 98, 99, 105, 104, 35, 28, 107, 103, 110, 24, 30, 49, 101, 97, 104, 24, 24)
    For i = 0 To UBound(arr)
        abc = abc & ChrW(arr(i) + i)
    Next
End Function[/COLOR]

Xóa hết chỗ màu đỏ đi và sửa chỗ màu xanh thành TRUE là được rồi
(function này nhìn buồn cười quá đi mất Định chơi trò "bí hiểm" đây!)

 

[dangphongpro2010]

Thêm 1 lựa chọn cho bạn
Khi nào cần Highlight thì đánh dấu vào Check box "Highlight", còn kg cần thì bỏ dấu Check box

Sao mình thấy checkbox ko hoạt động Bạn ơi, Bạn xem lại xem sao. Hay mình thao tác gì sai ta..

 

[Hong.Van]

Tôi thấy trong file có code thế này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If CheckBox21 = False Then Exit Sub
    Cells.FormatConditions.Delete
    ActiveCell.EntireRow.FormatConditions.Add 2, , [COLOR=#0000cd]abc[/COLOR]
    ActiveCell.EntireRow.FormatConditions(1).Interior.ColorIndex = 8
End Sub
[COLOR=#ff0000]Private Function abc() As String
    Dim arr(), i As Long
    arr = Array(61, 98, 99, 105, 104, 35, 28, 107, 103, 110, 24, 30, 49, 101, 97, 104, 24, 24)
    For i = 0 To UBound(arr)
        abc = abc & ChrW(arr(i) + i)
    Next
End Function[/COLOR]

Xóa hết chỗ màu đỏ đi và sửa chỗ màu xanh thành TRUE là được rồi
(function này nhìn buồn cười quá đi mất Định chơi trò "bí hiểm" đây!)

Hic, cái này em lấy code của bài 13 (QuangHai) em làm
Sao em làm như Thầy, thì dòng Highlight (màu xanh) kg tự mất khi bỏ Check box!

 

[Hong.Van]

Sao mình thấy checkbox ko hoạt động Bạn ơi, Bạn xem lại xem sao. Hay mình thao tác gì sai ta..

Bạn thử Save tạm vào đâu đó, tắt File rồi mở thử file lên, nhớ bấm Enable macros

 

[dangphongpro2010]

Bạn thử Save tạm vào đâu đó, tắt File rồi mở thử file lên, nhớ bấm Enable macros

Sao làm như Bạn mà vẫn ko dc..hic hic..sao kì dzậy ta..

 

[ndu96081631]

Sao em làm như Thầy, thì dòng Highlight (màu xanh) kg tự mất khi bỏ Check box!

Nếu bạn không làm như TUI (tức để nguyên code cũ) thì dòng màu xanh có tự mất khi bỏ CheckBox không?

 

[Hong.Van]

Nếu bạn không làm như TUI (tức để nguyên code cũ) thì dòng màu xanh có tự mất khi bỏ CheckBox không?

Thưa có, khi chuyển qua xem File hay sheet kháchoặc khi kéo bảng tính xuống (nói chung khi có 1 tác động khác) thì dòng Highlight sẽ tự biến mất

 

[ndu96081631]

Thưa có, khi chuyển qua xem File hay sheet kháchoặc khi kéo bảng tính xuống (nói chung khi có 1 tác động khác) thì dòng Highlight sẽ tự biến mất

Bạn thí nghiệm thế này nhé:
- Mở file của bạn lên
- Check vào CheckBox
- Di chuột chọn vào cell bất kỳ tại dòng 10
- Xong, bỏ check thằng CheckBox đi rồi chọn vào cell bất kỳ tại dòng khác ---> Cứ cho là màu xanh đã biến mất như bạn nói nhé
- Giờ lại chọn vào cell bất kỳ ở dòng 10, gõ nhăng nhít gì đó tùy ý rồi bấm mũi tên sang phải (không Enter)
Xem bạn nhìn thấy gì?

 

[Hong.Van]

Bạn thí nghiệm thế này nhé:
- Mở file của bạn lên
- Check vào CheckBox
- Di chuột chọn vào cell bất kỳ tại dòng 10
- Xong, bỏ check thằng CheckBox đi rồi chọn vào cell bất kỳ tại dòng khác ---> Cứ cho là màu xanh đã biến mất như bạn nói nhé
- Giờ lại chọn vào cell bất kỳ ở dòng 10, gõ nhăng nhít gì đó tùy ý rồi bấm mũi tên sang phải (không Enter)
Xem bạn nhìn thấy gì?

Em thấy hiện lại dòng Highlight!!!

 

[ndu96081631]

Em thấy hiện lại dòng Highlight!!!

Tức là code chưa đúng! Sửa lại thì cũng chỉ thay abc thành TRUE, hoàn toàn không thay đổi gì về cấu trúc code cả. Phân tích sẽ thấy rằng:
- Khi đang thực hiện Highlight rồi bạn bỏ check cái CheckBox đi
- Do trong code của bạn có đoạn If CheckBox21 = False Then Exit Sub nên khi bỏ checkbox thì code sẽ không làm gì nữa và cái Conditional Formatiing vẫn còn tồn tại (có thể bấm F5 chọn Special\Conditional Formats để kiểm tra)
Muốn sửa cho đúng thì phải thế này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Cells.FormatConditions.Delete
  If CheckBox21 = False Then Exit Sub
  ActiveCell.EntireRow.FormatConditions.Add 2, , True
  ActiveCell.EntireRow.FormatConditions(1).Interior.ColorIndex = 8
End Sub

tức tráo đổi 2 dòng code số 2 và số 3 cho nhau
Chuẩn hơn một chút:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  [COLOR=#ff0000]If Cells.FormatConditions.Count Then Cells.FormatConditions.Delete[/COLOR]
  If CheckBox21 = False Then Exit Sub
  ActiveCell.EntireRow.FormatConditions.Add 2, , True
  ActiveCell.EntireRow.FormatConditions(1).Interior.ColorIndex = 8
End Sub

Cải tiến tiếp:

[COLOR=#ff0000]Private Sub CheckBox21_Click()
  If CheckBox21 = False Then
    If Cells.FormatConditions.Count Then Cells.FormatConditions.Delete
  End If
End Sub[/COLOR]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 [COLOR=#ff0000] If Cells.FormatConditions.Count Then Cells.FormatConditions.Delete[/COLOR]
  If CheckBox21 = False Then Exit Sub
  ActiveCell.EntireRow.FormatConditions.Add 2, , True
  ActiveCell.EntireRow.FormatConditions(1).Interior.ColorIndex = 8
End Sub

Và cái cuối cùng này tôi cho là tạm chấp nhận:

[COLOR=#ff0000]Private Sub CheckBox21_Click()
  If CheckBox21 = False Then DelCF
End Sub[/COLOR]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  [COLOR=#ff0000]DelCF[/COLOR]
  If CheckBox21 = False Then Exit Sub
  ActiveCell.EntireRow.FormatConditions.Add 2, , True
  ActiveCell.EntireRow.FormatConditions(1).Interior.ColorIndex = 8
End Sub
[COLOR=#ff0000]Private Sub DelCF()
  If Cells.FormatConditions.Count Then Cells.FormatConditions.Delete
End Sub[/COLOR]

 

[Quang_Hải]

Anh NDU làm hết vui rồi, lộ hàng hết rồi còn gì.

 

[KUMI]

Một kiểu HighLight nữa !

Xin chào mọi người!
Em đứng ngoài thấy các Sư Phụ hứng thú quá nên cũng xin phép nhảy vào bon chen tý xíu ạ,code chỉ là sưu tầm còn kiến thức & kinh nghiệm thì quá non nớt nên bài viết mà có sự thắc mắc mong các sư phụ hỗ trợ ạ.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "HighLight" Then
        On Error GoTo Thoat
        If Not Intersect(Target, ActiveSheet.[D6:L30]) Is Nothing And Sheets("HighLight").HighLightObj = True Then
            HighLight Sh, Target
        Else
            Dim Shp As Shape
            Sh.Shapes("line_row").Delete
            Sh.Shapes("line_col").Delete
        End If
    End If
Thoat:
    Exit Sub
End Sub


Private Sub checkHighLight(ByVal Sh As Object)
    Dim Shp As Shape, FlagExistH As Boolean, FlagExistV As Boolean
    For Each Shp In Sh.Shapes
        If Shp.Name = "line_row" Then
            FlagExistH = True
        End If
        If Shp.Name = "line_col" Then
            FlagExistV = True
        End If
    Next
    If FlagExistH = False Then
        Sh.Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0).Name = "line_row"
    End If
    If FlagExistV = False Then
        Sh.Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0).Name = "line_col"
    End If
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Dim Shp As Shape
    For Each Shp In Sh.Shapes
        If Shp.Name = "line_row" Then
            Shp.Delete
        ElseIf Shp.Name = "line_col" Then
            Shp.Delete
        End If
    Next
End Sub


Private Sub HighLight(Sh As Object, Target As Range)
    On Error Resume Next
    checkHighLight Sh
    With Sh.Shapes("line_row")
        .Left = Columns("A:B").Width
        .Top = ActiveCell.Offset(1, 1).Top
        .Width = ActiveCell.Left - 95
        .Rotation = 0
        .ShapeStyle = 3
        .Line.Weight = 1.5
    End With
    With Sh.Shapes("line_col")
        .Left = ActiveCell.Offset(1, 1).Left
        .Top = Rows("1:4").Height
        .Height = ActiveCell.Top - 60
        .Rotation = 0
        .ShapeStyle = 3
        .Line.Weight = 1.5
    End With
End Sub

 

[zhong]

Chào mọi người,
Cho em hỏi có thể tạo highlight cho 1 dòng khi di chuyển trỏ đến dòng đó, và khi di chuyển trỏ chuột đến dòng khác, thì vị trí cũ sẽ trở lại bình thường như trước (vẫn giữ nguyên cách định dạng cũ) Em xin cảm ơn.

Bạn xem bài viết này: http://www.giaiphapexcel.com/forum/...iển-thị-mầu-cho-dòng-có-chứa-ô-hiện-tại/page2