Giúp mình code Mouse move khi rê chuột lên cell

9 Responses

1. hands says:

   31/05/2023 at 4:16 pm

   Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Rws As Long: Dim Rng As Range

   Rws = .End(xlUp).Row
   Set Rng = .Resize(Rws)
   If Not Intersect(Target, Rng) Is Nothing Then
   MsgBox Target.Offset(, 1).Value, , "Xin Chào"
   End If
   End Sub

   Cám ơn bạn rất nhiều, để mình chạy thử. Ủa mà code này áp dụng cho đề bài của mình phải ko bạn? Thấy khác khác nhỉ

   Trên bảng tính excel không có sự kiện Mouse Move, nhưng có thể ăn gian bằng cách chạy code nạp hết cột B vào comment thì khi ta đưa chuột đến ô nào đó của cột A thì comment sẽ tự hiện ra. Tuy nhiên thấy kỳ kỳ nên không muốn code

   Reply
2. hands says:

   31/05/2023 at 4:16 pm

   Trên bảng tính excel không có sự kiện Mouse Move, nhưng có thể ăn gian bằng cách chạy code nạp hết cột B vào comment thì khi ta đưa chuột đến ô nào đó của cột A thì comment sẽ tự hiện ra. Tuy nhiên thấy kỳ kỳ nên không muốn code

   Sao không làm cái comment hiện lên cho đẹp hở bác?

   @Tác giả bài đăng: Hãy thử tự làm theo khuyến cáo #6 của MAIKA 8008

   (Nếu có khó khăn thì mở bộ thu macro lên, nó sẽ giúp tận tình!)

   Dạ, e hiểu rồi. Cám ơn anh rất nhiều
   Mò mẫm thì thấy diên đàn mình có chủ để giống như thế này
   http://www.giaiphapexcel.com/diendan/threads/l%E1%BA%A5y-d%E1%BB%AF-li%E1%BB%87u-c%E1%BB%A7a-%C3%B4-kh%C3%A1c-l%C3%A0m-comment-cho-%C3%B4-hi%E1%BB%87n-t%E1%BA%A1i.159189/
   Anh hướng dẫn em " chạy code nạp hết cột B vào comment" với ạ, e ghi cho 1 cell thì đc nhưng làm sao để nạp 1 lần comment cho cột A thì e ko rõ?
   Cám ơn anh

   Thử code này. Thay thế tên sheet và vùng cần xử lý cho phù hợp cho phù hợp. Code này giả định dữ liệu bắt đầu từ A1

   Sub Add_Comment()
   Dim sArr(), i As Long
   With Sheets("Sheet1")
       sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 2).Value
       For i = 1 To UBound(sArr)
           .Cells(i, 1).ClearComments
           .Cells(i, 1).AddComment CStr(sArr(i, 2))
       Next
   End With
   End Sub

   Reply
3. hands says:

   31/05/2023 at 4:17 pm

   @Tác giả bài đăng: Hãy thử tự làm theo khuyến cáo #6 của MAIKA 8008

   (Nếu có khó khăn thì mở bộ thu macro lên, nó sẽ giúp tận tình!)

   Thử code này. Thay thế tên sheet và vùng cần xử lý cho phù hợp cho phù hợp. Code này giả định dữ liệu bắt đầu từ A1

   Sub Add_Comment()
   Dim sArr(), i As Long
   With Sheets("Sheet1")
       sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 2).Value
       For i = 1 To UBound(sArr)
           .Cells(i, 1).ClearComments
           .Cells(i, 1).AddComment CStr(sArr(i, 2))
       Next
   End With
   End Sub

   Tôi thấy thay vì rê chuột lên ô thì bấm chuột vào ô cũng đâu có gì bất tiện. Chủ thớt chép code này vào module của sheet cần dùng rồi thử cách hoạt động của nó xem: Bấm vào 1 ô cột A từ A2 trở xuống thì hiện comment ô đó và xóa comment các ô khác trong cột. Bấm ra ngoài cột A thì xóa comment (các) ô trong cột A.

   Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       Dim sCmt$
       Range(Cells(1, 1), Cells(10000, 1)).ClearComments
       If Target.Row > 1 And Target.Column = 1 And Target.Count = 1 Then
           sCmt = Cells(Target.Row, 2).Text
           Target.AddComment
           Target.Comment.Text sCmt
       End If
   End Sub

   /-)úng là không có gì bất tiện khi vận hành, nhưng tốn điện là cái chắc!

   → 😀 😀 😀 ← → 😀 😀 😀 ← → 😀 😀 😀 ← → 😀 😀 😀 ← → 😀 😀 😀 ← → 😀 😀 😀 ← → 😀 😀 😀 ←

   Reply
4. hands says:

   31/05/2023 at 4:17 pm

   @Tác giả bài đăng: Hãy thử tự làm theo khuyến cáo #6 của MAIKA 8008

   (Nếu có khó khăn thì mở bộ thu macro lên, nó sẽ giúp tận tình!)

   Thử code này. Thay thế tên sheet và vùng cần xử lý cho phù hợp cho phù hợp. Code này giả định dữ liệu bắt đầu từ A1

   Sub Add_Comment()
   Dim sArr(), i As Long
   With Sheets("Sheet1")
       sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 2).Value
       For i = 1 To UBound(sArr)
           .Cells(i, 1).ClearComments
           .Cells(i, 1).AddComment CStr(sArr(i, 2))
       Next
   End With
   End Sub

   Tại sao cứ cưỡng ép nó phải add cái comment vô, trong khi Validation có cái chức năng "Show Input Message" như thế này:
   Và kết quả là không thêm bớt gì hết vô cột A cả.

   6848

   Option Explicit
   Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub
   With Target.Validation
   .Delete
   .Add Type:=xlValidateInputOnly
   .InputMessage = Target.Offset(, 1).Value
   End With
   End Sub

   Reply
5. hands says:

   31/05/2023 at 4:19 pm

   Tại sao cứ cưỡng ép nó phải add cái comment vô, trong khi Validation có cái chức năng "Show Input Message" như thế này:
   Và kết quả là không thêm bớt gì hết vô cột A cả.

   6848

   Option Explicit
   Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub
   With Target.Validation
   .Delete
   .Add Type:=xlValidateInputOnly
   .InputMessage = Target.Offset(, 1).Value
   End With
   End Sub

   Vẫn phải thêm cái chuỗi để show chứ bạn. Nếu không xóa nó đi khi rời khỏi ô thì nó vẫn còn đó và tăng "trọng lượng" cho file ấy chứ.

   Xóa thì đơn giản, nhưng phụ thuộc việc DataValidation nó có ảnh hưởng đến mức cần thiết phải xóa hay không thôi. Nói thêm là DataValidation này không khống chế việc nhập dữ liệu hay ràng buộc kiểu dữ liệu, mà chỉ đơn thuần phục vụ chi việc "show" text ra thôi.
   Bổ sung về sự kiện "rê chuột" trên cell:
   Cho đến hiện tại thì VBA code chưa hỗ trợ sự kiện này nhé. Nếu MouseMove trên object thì OK.

   Reply
6. hands says:

   01/06/2023 at 11:55 am

   Dạ, thực ra ko bắt buộc là MouseMove đâu anh, mục đích là đưa chuột qua cell Cột A thì hiện thị thông tin cell Cột B (bị ẩn) bên cạnh. Ý tưởng đưa vào Commnet của anh theo em là hợp lý, để e thử code anh gửi có gì cho anh hay.
   Các cao thủ có ý tưởng gì khác cho đề bài này thì cho em xin lĩnh hội luôn nha.
   Xin cám ơn

   Cao thủ với ý tưởng cái monkey á. Chừng đó bài đến giờ còn chưa thử hết. Cảm ơn bài #11 từ bài #14 đến giờ vẫn còn "để em thử code…", ở đó mà lĩnh hội, lĩnh họp.

   6900
   Để rõ hơn thì vd này: các giá trị OK1 sẽ từ mức 22% trở lên. Khi mình muốn đánh giá ưu tiên cái nào sử dụng trước thì mình để chuột lên bất kì cell nào của cột F nó sẽ xuất hiện thông tin % tương ứng của cột G (bị ẩn) dạng comment hoặc note. Giá trị cột G là kết quả của hàm lấy từ các thông số khác tùy dữ liệu nạp vào, chứ ko cố định.

   Nếu thế này thì Group hay hơn, nhìn được vài dòng liên tục.

   Group cột hả bạn? mình đang Group đó, nhưng muốn xem lại phải mở ra, mà mình ko muốn tăng bề rộng của bảng

   Cơ bản là với cái ảnh thì muốn biết % cái nào lớn hơn nữa thì phải di chuột đến từng ô cũng mất thời gian phết. Nhu cầu hơi khó hiểu.
   Tớ hỏi kỹ vì tớ chỉ thấy cái này có tác dụng nếu cột ẩn quá dài, mà yêu cầu chỉ muốn thể hiện ngắn gọn ý chính thì còn hợp lý. VD áp dụng trong biểu đồ Gantt chẳng hạn. Chứ như thế kia, trước khi đóng lại thì ta click Group là xong.
   Hiện tại tớ chỉ thấy nó hợp với anh em xây dựng về quản lý dự án, viết hồi ký thi công.

   Mousemove lại vô tình nằm trong Sub của bác Hải, chốt lại excel thực sự có sự kiện mousemove đặc chủng.

   Bữa nay mới biết có 1 thứ gọi là "hồi ký" thi công

   Nó là loại hồ sơ mang tính chất đặc biệt bác ạ, dùng rất nhiều trí tuệ của anh em để tránh việc đá bôm bốp.

   Reply
7. hands says:

   01/06/2023 at 11:55 am

   Cao thủ với ý tưởng cái monkey á. Chừng đó bài đến giờ còn chưa thử hết. Cảm ơn bài #11 từ bài #14 đến giờ vẫn còn "để em thử code…", ở đó mà lĩnh hội, lĩnh họp.

   Nếu thế này thì Group hay hơn, nhìn được vài dòng liên tục.

   Cơ bản là với cái ảnh thì muốn biết % cái nào lớn hơn nữa thì phải di chuột đến từng ô cũng mất thời gian phết. Nhu cầu hơi khó hiểu.
   Tớ hỏi kỹ vì tớ chỉ thấy cái này có tác dụng nếu cột ẩn quá dài, mà yêu cầu chỉ muốn thể hiện ngắn gọn ý chính thì còn hợp lý. VD áp dụng trong biểu đồ Gantt chẳng hạn. Chứ như thế kia, trước khi đóng lại thì ta click Group là xong.
   Hiện tại tớ chỉ thấy nó hợp với anh em xây dựng về quản lý dự án, viết hồi ký thi công.

   Mousemove lại vô tình nằm trong Sub của bác Hải, chốt lại excel thực sự có sự kiện mousemove đặc chủng.

   Nó là loại hồ sơ mang tính chất đặc biệt bác ạ, dùng rất nhiều trí tuệ của anh em để tránh việc đá bôm bốp.

   @thinhdje Dùng hàm UDF được không bạn:

   Gõ tại ô G2 =LiveComment(<giá trị G2>,F2) Fill xuống

   Function LiveComment(value, refCell As Range)
     On Error Resume Next
     With refCell
       If Not .Comment Is Nothing Then .ClearComments
       With .AddComment(CStr(value)).shape
           With .TextFrame
             .AutoSize = 1
             .AutoSize = 0
           End With
         .Width = .Width + 20
       End With
     End With
     LiveComment = value
   End Function

   Hàm này là đúng ý mình nhất. Cám ơn bạn rất nhiều nhiều
   6901
   Mình muốn cho kích thước comment vừa fix với nội dung, thử thay đổi các thông số mà chưa đc. Mình hơi dốt VB 😀

   Việc rê chuột lên cell và hiển thị thông tin, có rất nhiều câu hỏi yêu cầu việc này.Như tôi đã đề cập bài trước, VBA không nhận biết được việc mouse hover lên cell, nhưng shape/object thì OK.Do đó, đã có trường hợp "lách" bằng cách lồng object vào cell (vẽ 1 hình chữ nhật và lồng vào cell, ví dụ: A1), ẩn nó đi. Như vậy, tại ô A1 có 2 lớp: cell và object.Khi rê chuột lên A1, đồng nghĩa sự kiện mousehover xảy ra cho object, việc còn lại là chỉ việc viết code lấy vị trí của object này.

   Reply
8. hands says:

   01/06/2023 at 11:55 am

   Cao thủ với ý tưởng cái monkey á. Chừng đó bài đến giờ còn chưa thử hết. Cảm ơn bài #11 từ bài #14 đến giờ vẫn còn "để em thử code…", ở đó mà lĩnh hội, lĩnh họp.

   Nếu thế này thì Group hay hơn, nhìn được vài dòng liên tục.

   Cơ bản là với cái ảnh thì muốn biết % cái nào lớn hơn nữa thì phải di chuột đến từng ô cũng mất thời gian phết. Nhu cầu hơi khó hiểu.
   Tớ hỏi kỹ vì tớ chỉ thấy cái này có tác dụng nếu cột ẩn quá dài, mà yêu cầu chỉ muốn thể hiện ngắn gọn ý chính thì còn hợp lý. VD áp dụng trong biểu đồ Gantt chẳng hạn. Chứ như thế kia, trước khi đóng lại thì ta click Group là xong.
   Hiện tại tớ chỉ thấy nó hợp với anh em xây dựng về quản lý dự án, viết hồi ký thi công.

   Mousemove lại vô tình nằm trong Sub của bác Hải, chốt lại excel thực sự có sự kiện mousemove đặc chủng.

   Nó là loại hồ sơ mang tính chất đặc biệt bác ạ, dùng rất nhiều trí tuệ của anh em để tránh việc đá bôm bốp.

   Do công việc mình hay sử dụng bằng điện thoại mở file nên muốn luôn để trạng thái ít cột nhất có thể, chứ nếu chỉ máy tính thì ko thành vấn đề

   Có liên quan nên em hỏi luôn.
   Em muốn khống chế bề rộng comment là 500, chiều cao auto vừa khít theo số lượng text tràn xuống.
   Có code được vậy không ạ?

   Reply
9. hands says:

   01/06/2023 at 1:19 pm

   @thinhdje Dùng hàm UDF được không bạn:

   Gõ tại ô G2 =LiveComment(<giá trị G2>,F2) Fill xuống

   Function LiveComment(value, refCell As Range)
     On Error Resume Next
     With refCell
       If Not .Comment Is Nothing Then .ClearComments
       With .AddComment(CStr(value)).shape
           With .TextFrame
             .AutoSize = 1
             .AutoSize = 0
           End With
         .Width = .Width + 20
       End With
     End With
     LiveComment = value
   End Function

   Việc rê chuột lên cell và hiển thị thông tin, có rất nhiều câu hỏi yêu cầu việc này.Như tôi đã đề cập bài trước, VBA không nhận biết được việc mouse hover lên cell, nhưng shape/object thì OK.Do đó, đã có trường hợp "lách" bằng cách lồng object vào cell (vẽ 1 hình chữ nhật và lồng vào cell, ví dụ: A1), ẩn nó đi. Như vậy, tại ô A1 có 2 lớp: cell và object.Khi rê chuột lên A1, đồng nghĩa sự kiện mousehover xảy ra cho object, việc còn lại là chỉ việc viết code lấy vị trí của object này.

   Khi mình đưa và Google Sheet thì nó báo lỗi này:
   6913
   Liệu có dùng trong GS được ko bạn?

   @thinhdje Không còn cách nào khác:
   (***VBA không thể đưa vào Google Spreadsheets)

   '                    _,
   ' ___   _   _  _ ___(_)
   '/ __| /  | | | _ | |
   '__ /  | \ | _  |
   '|___/_/ _|_|_|___/_|
   '
   Option Explicit
   #If VBA7 Then
   #Else
     Public Enum LongLong:[_]:End Enum
     #If Win64 Then
     #Else
       Public Enum LongPtr:[_]:End Enum
     #End If
   #End If
   
   Public Const PtrNull As LongPtr = 0
   Private Type TypeArguments
     Caller As Range
     comment As String
     cells As Variant
     FontBold As Boolean
     FontSize As Single
   End Type
   
   #If VBA7 Then
     Private Declare PtrSafe Function SetTimer Lib "USER32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
     Private Declare PtrSafe Function KillTimer Lib "USER32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
   #Else
     Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
     Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
   #End If
   
   Private Works() As TypeArguments
   
   Function LiveComment(value, ParamArray cells())
     LiveComment = value
     On Error Resume Next
     Dim k%, rg: Set rg = Application.ThisCell
     LiveComment = value
     k = UBound(Works): k = k + 1: ReDim Preserve Works(1 To k)
     With Works(k): Set .Caller = rg: .comment = value: .cells = cells: End With
     Call SetTimer(0&, 0&, 0, AddressOf LiveComment_callback)
   End Function
   
   Private Sub LiveComment_callback(ByVal hWnd As LongPtr, ByVal wMsg As LongPtr, ByVal idEvent As LongPtr, ByVal dwTime As LongPtr)
     On Error Resume Next
     KillTimer 0&, idEvent
     Dim lr&, UA%, i&, b As TypeArguments, cell
     UA = UBound(Works)
     For i = 1 To UA
       b = Works(i)
       For Each cell In b.cells
         If TypeName(cell) = "Range" Then
           cell.comment.Delete
           cell.AddComment b.comment
           With cell.comment
             .Shape.TextFrame.AutoSize = 0
             .Shape.TextFrame.AutoSize = 1
             .Shape.Width = .Shape.Width + 10
           End With
         End If
       Next
     Next
     Erase Works
     On Error GoTo 0
   End Sub

   Reply