Tạo hiệu ứng cho Cell (1 người xem)

[Thanhvietin]

Các bác giúp Em tạo hiệu ứng cho Cell với!

Chẳng hạn như Em có Cell H10 có giá trị >= 1, bây giờ Em muốn khi di chỏ chuột vào cell H10 đó thì excel sẽ hiện lên một thông báo (giống như comment) với nội dung "sắp đến hạn thanh toán", khi di chỏ chuột ra ngoài thì thông báo đó cũng "biến mất".

Em tìm trên GPE mà mãi không thấy. Các bác có cách nào giúp em với nhé!

Cảm ơn nhiều nhiều!

 

[Hai Lúa Miền Tây]

Các bác giúp Em tạo hiệu ứng cho Cell với!

Chẳng hạn như Em có Cell H10 có giá trị >= 1, bây giờ Em muốn khi di chỏ chuột vào cell H10 đó thì excel sẽ hiện lên một thông báo (giống như comment) với nội dung "sắp đến hạn thanh toán", khi di chỏ chuột ra ngoài thì thông báo đó cũng "biến mất".

Em tìm trên GPE mà mãi không thấy. Các bác có cách nào giúp em với nhé!

Cảm ơn nhiều nhiều!

Bạn dùng code củ chuối sau thử nhé.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
With Range("H10")
    .AddComment
    If .Value >= 1 Then
        .Comment.Text "Sap den han thanh toan"
    Else
        .Comment.Text "Chua den han thanh toan"
    End If
End With
End Sub

 

[quemai81]

có thể làm bằng cách khác k vậy bạn ? mình k hiểu code nên cũng k thích (xin lỗi) , nhân đây cũng cho mình hỏi lám sao tải code về và cách sử dụng nhé .

 

[Thanhvietin]

Bạn dùng code củ chuối sau thử nhé.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
With Range("H10")
    .AddComment
    If .Value >= 1 Then
        .Comment.Text "Sap den han thanh toan"
    Else
        .Comment.Text "Chua den han thanh toan"
    End If
End With
End Sub

Cảm ơn bạn! Nhưng tại sao khi giá trị tại cell H10<1 mà cái thông báo đó không biến mất đi?

 

[Hai Lúa Miền Tây]

Cảm ơn bạn! Nhưng tại sao khi giá trị tại cell H10<1 mà cái thông báo đó không biến mất đi?

Chỉnh lại như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
With Range("H10")
    .AddComment
    If .Value >= 1 Then
        .Comment.Text "Sap den han thanh toan"
    Else
        .Comment.Delete
    End If
End With
End Sub

 

[Thanhvietin]

Chỉnh lại như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
With Range("H10")
    .AddComment
    If .Value >= 1 Then
        .Comment.Text "Sap den han thanh toan"
    Else
        .Comment.Delete
    End If
End With
End Sub

Cảm ơn bác nhiều nhiều! Rất tuyệt!
Giúp thì giúp cho chót, bác làm ơn chuyển cell H10 thành toàn bộ cột H được không? em hì hục mãi mà không chuyển được.
Lần nữa cảm ơn bác nhiều nhiều!

 

[nmhung49]

Thứ code này xem sao nhen

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Columns("H:H"), Target) Is Nothing Then
    With Target
        .AddComment
        If .Value >= 1 Then
            .Comment.Text "Sap den han thanh toan"
        Else
            .Comment.Delete
        End If
    End With
End If

End Sub

 

[Hai Lúa Miền Tây]

Hoặc dùng code sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
With Cells(ActiveCell.Row, 8)
    .AddComment
    If .Value >= 1 Then
        .Comment.Text "Sap den han thanh toan"
    Else
        .Comment.Delete
    End If
End With

End Sub

 

[ndu96081631]

Cảm ơn bác nhiều nhiều! Rất tuyệt!
Giúp thì giúp cho chót, bác làm ơn chuyển cell H10 thành toàn bộ cột H được không? em hì hục mãi mà không chuyển được.
Lần nữa cảm ơn bác nhiều nhiều!

Sửa thành vầy:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Clls As Range
  On Error Resume Next
  If Not Intersect(Range("[COLOR=#ff0000][B]H10:H100[/B][/COLOR]"), Target) Is Nothing Then
    If Target.Count = 1 Then
      For Each Clls In Range("[COLOR=#ff0000][B]H10:H100[/B][/COLOR]")
        Clls.Comment.Delete
        If Clls.Value >= 1 Then Clls.AddComment ("Sap den han thanh toan")
      Next
    End If
  End If
End Sub

Chổ H10:H100 bạn muốn khác hơn thì sửa lại nhé
Code này chưa phải là tối ưu nhất nhưng cứ xài tạm... Nếu dữ liệu nhiều quá, ta có thể sửa lại chút để tăng tốc

 

[Thanhvietin]

Sửa thành vầy:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Clls As Range
  On Error Resume Next
  If Not Intersect(Range("[COLOR=#ff0000][B]H10:H100[/B][/COLOR]"), Target) Is Nothing Then
    If Target.Count = 1 Then
      For Each Clls In Range("[COLOR=#ff0000][B]H10:H100[/B][/COLOR]")
        Clls.Comment.Delete
        If Clls.Value >= 1 Then Clls.AddComment ("Sap den han thanh toan")
      Next
    End If
  End If
End Sub

Chổ H10:H100 bạn muốn khác hơn thì sửa lại nhé
Code này chưa phải là tối ưu nhất nhưng cứ xài tạm... Nếu dữ liệu nhiều quá, ta có thể sửa lại chút để tăng tốc

Oh, quá tuyệt! Cảm ơn các Bác! được rồi.
Vậy mà em hì hục mãi không xong, vài bữa nữa Em vác sách vở đến để bái Sư.
Hỏi nhiều thấy xấu hổ nhưng không hỏi thì không biết.
Cảm ơn Sư phụ nhiều lắm!