Moving and locking a Comment Box

mikeb7500

Board Regular
Joined
Jul 30, 2014
Messages
73
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!
 
Last edited:

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
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:
Code:
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
 
Last edited:

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,846
Office Version
2016
Platform
Windows
There was a subtle error in the previous code, so please, dismiss it and use the following one:


Code in the ThisWorkbook module:
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,100,141
Messages
5,472,753
Members
406,835
Latest member
steve43040

This Week's Hot Topics

Top