vba to change the position of comment boxes on mouse-over

[cjcass]

Hello,

I have found code that you can use to change the position of comment boxes when then comments are permanently visible, but not when the comments are displayed on mouse-over only. Does anyone know of a code solution to achieve this? It's to resolve the classic situation where comment boxes at the periphery of the screen are only partly visible. I'm really looking for a 'comment box' solution (if achievable) as my workbook is already heavily geared towards using comments.

Any help would be much appreciated.

 

[Yongle]

I assume that you are referring to the "old" comment

The difference between threaded comments and notes - Microsoft Support

Comments and notes are new in Excel for Office 365. This article explains the differences.

support.microsoft.com

This may not be exactly what you want, but it is simple and provides cell comment text in a message box that is always visible
Place code in ThisWorkbook module and then click on any cell in any sheet to see its comment

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Dim t As String: t = Target.Comment.Text
    On Error GoTo 0
    If Len(t) > 0 Then MsgBox t, , Target.Address(0, 0)
End Sub

 

[Jaafar Tribak]

Here is a class code workaround that should reposition into view all comments that are fully or partially off-Screen :

Workbook Example


1- Class code ( Calss name is clsCommentsRepositioner )

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
        Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
        Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
#Else
        Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
        Private Declare Function GetActiveWindow Lib "user32" () As Long
#End If

Private WithEvents cmndbars As CommandBars


Private Sub Class_Initialize()
    Set cmndbars = Application.CommandBars
    Call cmndbars_OnUpdate
End Sub


Private Sub cmndbars_OnUpdate()

    Static oPrevRange As Range
    Dim tCurPos As POINTAPI, oRange As Range, oComment As Comment
  
    On Error Resume Next
  
    If GetActiveWindow <> Application.Hwnd Then Exit Sub
  
    Call GetCursorPos(tCurPos)
    Set oRange = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
  
    If oRange.Address <> oPrevRange.Address Then
  
        With oPrevRange.Comment
            .Visible = False
            .Shape.Top = .Parent.Top - 10
            .Shape.Left = .Parent.Offset(0, 1).Left + 15
        End With
      
        Set oComment = oRange.Comment
        If Not oComment Is Nothing Then
            If oComment.Parent.Row = ActiveWindow.VisibleRange.Row Then
                oComment.Visible = True
                oComment.Shape.Top = oComment.Parent.Offset(1).Top
            End If
            If IsOffScreenX(oComment) Then
                oComment.Shape.Left = oComment.Parent.Left - oComment.Shape.Width
            End If
            If IsOffScreenY(oComment) Then
                oComment.Shape.Top = oComment.Parent.Top - oComment.Shape.Height
            End If
        End If
      
    End If
  
    Set oPrevRange = oRange
    With Application.CommandBars.FindControl(ID:=2020): .Enabled = Not .Enabled: End With

End Sub

Private Function IsOffScreenX(ByVal Comment As Comment) As Boolean

    Dim tCommentRect As RECT
  
    Comment.Visible = True
    tCommentRect = GetRangeRect(Comment.Shape)
    If ActiveWindow.RangeFromPoint(tCommentRect.Right, tCommentRect.Top) Is Nothing Then
        IsOffScreenX = True
    End If

End Function


Private Function IsOffScreenY(ByVal Comment As Comment) As Boolean

    Dim tCommentRect As RECT
  
    Comment.Visible = True
    tCommentRect = GetRangeRect(Comment.Shape)
    If ActiveWindow.RangeFromPoint(tCommentRect.Right, tCommentRect.Bottom) Is Nothing Then
        IsOffScreenY = True
    End If

End Function


Private Function GetRangeRect(ByVal Obj As Object) As RECT

    Dim oPane  As Pane
  
    Set oPane = ActiveWindow.ActivePane
    With GetRangeRect
        .Left = oPane.PointsToScreenPixelsX(Obj.Left)
        .Top = oPane.PointsToScreenPixelsY(Obj.Top)
        .Right = oPane.PointsToScreenPixelsX(Obj.Left + Obj.Width)
        .Bottom = oPane.PointsToScreenPixelsY(Obj.Top + Obj.Height)
    End With

End Function

2- Code Usage in the ThisWorkbook Module:

Option Explicit

Private oCommentsRepositioner As clsCommentsRepositioner

Private Sub Workbook_Activate()
    If oCommentsRepositioner Is Nothing Then
        EnableCommentsRepositioner = True
    End If
End Sub

Private Sub Workbook_Deactivate()
    EnableCommentsRepositioner = False
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If oCommentsRepositioner Is Nothing Then
        EnableCommentsRepositioner = True
    End If
End Sub

Private Property Let EnableCommentsRepositioner(ByVal Enable As Boolean)
    Set oCommentsRepositioner = Nothing
    If Enable Then
        Set oCommentsRepositioner = New clsCommentsRepositioner
    End If
End Property

 

[cjcass]

Hi Yongle,
Thanks for that code, although I can't use it in ths project (my comment boxes are formatted based on criteria, need to be mouse-over etc.) I will definitely be able to use it elsewhere, thanks for your time on this.

Hi Jaafar,
Thanks for your response, your code works fine in your 'Workbook Example'. I have inputted your Class Code and Worksheet Module into my own file exactly as you have described but it seems to have no effect on my comment boxes. Do you know of any reason why this could be?
Thanks for your time.

 

[Yongle]

Thanks for your response, your code works fine in your 'Workbook Example'. I have inputted your Class Code and Worksheet Module into my own file exactly as you have described but it seems to have no effect on my comment boxes. Do you know of any reason why this could be?
Thanks for your time.

did you save, close and re-open the workbook?

 

[cjcass]

Hi,

Ok, found the problem - I hadn't renamed the Class Module to clsCommentsRepositioner. This now works well, many thanks.

I have two final questions though if I may:
1) The comment boxes tend to occupy their default position first and then quickly move to their new position - it's quite rapid but it would look better if this didn't happen, could this be overcome? (note: this doesn't happen in your example but my comment boxes are much bigger so that may be why?)
2) Is there a bit of code that I could put behind a macro button to toggle 'enable/disable' this code if necessary?

Again, many thanks for your help with this.

 

[Yongle]

I will leave @Jaafar Tribak to deal with those questions - way beyond my knowledge level!

 

[Jaafar Tribak]

Hi,

Ok, found the problem - I hadn't renamed the Class Module to clsCommentsRepositioner. This now works well, many thanks.

I have two final questions though if I may:
1) The comment boxes tend to occupy their default position first and then quickly move to their new position - it's quite rapid but it would look better if this didn't happen, could this be overcome? (note: this doesn't happen in your example but my comment boxes are much bigger so that may be why?)
2) Is there a bit of code that I could put behind a macro button to toggle 'enable/disable' this code if necessary?

Again, many thanks for your help with this.

1)

Strange.. as you said, this doesn't happen in the workbook example that I posted.
I have tried increasing the size of the comments and the code still works the same - no flicker or lag.
Maybe it is because of the size of your workbook - just guessing.


2) Easy :

A- First, change the previous code located in the ThisWorkbook Module to this:

Option Explicit

Private oCommentsRepositioner As clsCommentsRepositioner
Private bEnable As Boolean

Private Sub Workbook_Activate()
    If oCommentsRepositioner Is Nothing Then
        EnableCommentsRepositioner = True
    End If
End Sub

Private Sub Workbook_Deactivate()
    EnableCommentsRepositioner = False
End Sub

Public Property Let EnableCommentsRepositioner(ByVal Enable As Boolean)
    Set oCommentsRepositioner = Nothing
    bEnable = Enable
    If Enable Then
        Set oCommentsRepositioner = New clsCommentsRepositioner
    End If
End Property

Public Property Get EnableCommentsRepositioner() As Boolean
    EnableCommentsRepositioner = bEnable
End Property

B- Put this behind the macro button :

Sub ToggleMacro()
    ThisWorkbook.EnableCommentsRepositioner = Not ThisWorkbook.EnableCommentsRepositioner
End Sub

PS: You can replace the Workbook_Activate() with the Workbook_Open() event and the Workbook_Deactivate() with the Workbook_BeforeClose() event.

 

[cjcass]

Great!!
Thanks for all your help with this Jaafar, really appreciated

 

[Jaafar Tribak]

Great!!
Thanks for all your help with this Jaafar, really appreciated

Glad I could help and thanks for the feedback.