Moving and locking a Comment Box

[mikeb7500]

I have a comment box that displays in a very bad position on my Excel 2016 Spreadsheet. Even when I move it under the Edit Comment Function, when I hover over the cell, it still displays in the the comment box in the original position. Is there anyway I can lock the comment box in the location I choose? Thanks!

 

[footoo]

https://excel.tips.net/T002887_Anchoring_Comment_Boxes_in_Desired_Locations.html

 

[Jaafar Tribak]

Try this :

You could use this workaround to display your comment(s) at a location of your choice in relation to a target cell.

In this example, the comment in cell A5 will be displayed over cell K4 and the comment in cell D8 over cell C20.


Code in the ThisWorkbook Module:

Option Explicit

Private WithEvents cmbrs As CommandBars
 
Private Type POINTAPI
    x As Long
    y As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If



Private Sub Workbook_Activate()

    Call HookComments

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Call HookComments
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call ClearCommentsTag

End Sub

Private Sub HookComments()

    [COLOR=#008000][B]'Diplay A5 comment in cell K4 and D8 comment in cell C20[/B][/COLOR]
    Call ClearCommentsTag
    Call SetCommentPos([COLOR=#ff0000]TheComment:=Sheet1.Range("A5").Comment[/COLOR], [COLOR=#0000ff]AnchorCell:=Sheet1.Range("k4")[/COLOR])
    Call SetCommentPos([COLOR=#ff0000]TheComment:=Sheet1.Range("D8").Commen[/COLOR]t, [COLOR=#0000ff]AnchorCell:=Sheet1.Range("C20")[/COLOR])

End Sub


Private Sub SetCommentPos(ByVal TheComment As Comment, ByVal AnchorCell As Range)

    TheComment.Shape.AlternativeText = "@*!" & AnchorCell.Address
    Set cmbrs = Application.CommandBars
    
End Sub


Private Sub ClearCommentsTag()

    Dim oSh As Worksheet, oCom As Comment
    
    For Each oSh In Me.Worksheets
        If oSh.ProtectContents = False Then
            For Each oCom In oSh.Comments
                If Left(oCom.Shape.AlternativeText, 3) = "@*!" Then
                    oCom.Shape.AlternativeText = ""
                End If
            Next
        End If
    Next oSh

End Sub

Private Sub cmbrs_OnUpdate()

    Dim tCurPos As POINTAPI, oRange As Range, sAnchor As String
    
    On Error Resume Next
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    GetCursorPos tCurPos
    Set oRange = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    sAnchor = oRange.Comment.Shape.AlternativeText
    If Left(sAnchor, 3) = "@*!" Then
        With oRange.Comment.Shape
            .Top = Range(Mid(sAnchor, 4, Len(sAnchor) - 3)).Top
            .Left = Range(Mid(sAnchor, 4, Len(sAnchor) - 3)).Left
        End With
        oRange.Comment.Visible = True
    End If
 
End Sub

 

[Jaafar Tribak]

There was a subtle error in the previous code, so please, dismiss it and use the following one:


Code in the ThisWorkbook module:

Option Explicit

Private WithEvents cmbrs As CommandBars
 
Private Type POINTAPI
    x As Long
    y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If



Private Sub Workbook_Activate()

    Call HookComments

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Call HookComments

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call ClearCommentsTag

End Sub


Private Sub HookComments()

    [B][COLOR=#008000]'Diplay A5 comment in cell K4 and D8 comment in cell C20[/COLOR][/B]
    Call ClearCommentsTag
    Call SetCommentPos([COLOR=#ff0000]TheComment:=Sheet1.Range("A5").Comment[/COLOR], [COLOR=#0000ff]AnchorCell:=Sheet1.Range("k4")[/COLOR])
    Call SetCommentPos([COLOR=#ff0000]TheComment:=Sheet1.Range("D8").Comment[/COLOR], [COLOR=#0000ff]AnchorCell:=Sheet1.Range("C20")[/COLOR])

End Sub


Private Sub SetCommentPos(ByVal TheComment As Comment, ByVal AnchorCell As Range)

    TheComment.Shape.AlternativeText = "@*!" & AnchorCell.Address
    Set cmbrs = Application.CommandBars
    
End Sub


Private Sub ClearCommentsTag()

    Dim oSh As Worksheet, oCom As Comment
    
    For Each oSh In Me.Worksheets
        If oSh.ProtectContents = False Then
            For Each oCom In oSh.Comments
                If Left(oCom.Shape.AlternativeText, 3) = "@*!" Then
                    oCom.Shape.AlternativeText = ""
                End If
            Next
        End If
    Next oSh

End Sub


Private Sub cmbrs_OnUpdate()

    Static oPrev As Range
    Dim tCurPos As POINTAPI, sAnchor As String
    Dim oRange As Range
    
    On Error Resume Next
    
    Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
    
    GetCursorPos tCurPos
    Set oRange = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    sAnchor = oRange.Comment.Shape.AlternativeText
    
    If Left(sAnchor, 3) = "@*!" Then
        Set oPrev = oRange
        Application.DisplayCommentIndicator = xlCommentIndicatorOnly
        With oRange.Comment.Shape
            .Top = Range(Mid(sAnchor, 4, Len(sAnchor) - 3)).Top
            .Left = Range(Mid(sAnchor, 4, Len(sAnchor) - 3)).Left
        End With
        oRange.Comment.Visible = True
    End If
    If Err.Number <> 0 Then
        oPrev.Comment.Visible = False
    End If
 
End Sub