comment positionning possible?

danmen

Board Regular
Joined
Jan 15, 2009
Messages
217
I have a spreadsheet with a lot comments and sometimes they position themselves too low ( I have to scroll the page to see them ) is there a way to lock their position? I'd like the lower right hand corner of each comment to touch the upper left hand corner of the source cell if possible, can such a thing be programmed? thx for any help :)
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
I'm familiar with that site but cant find any code to position a comment precisely or the way I described... maybe I missed it ????? =(
 
Upvote 0
See if this works for you :

Place this code in the WorkBook module :

Code:
Option Explicit
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Private Sub Workbook_Open()
 
    Call PositionComments
 
End Sub

Private Function HasComment(Target As Range) As Boolean
 
    Dim oCmmt            As Comment
    On Error Resume Next
    Set oCmmt = Target.Comment
    If Not oCmmt Is Nothing Then HasComment = True
 
End Function
 
Private Sub PositionComments()
 
    Dim tPt              As POINTAPI
    Static oPrevObj      As Object
    Dim oObj             As Object
    
    On Error Resume Next
    
    Do
        GetCursorPos tPt
        Set oObj = _
        Application.ActiveWindow.RangeFromPoint(tPt.X, tPt.Y)
        If TypeName(oObj) = "Range" Then
            If HasComment(oObj) Then
                With oObj
                    If oPrevObj.Address <> .Address Then
                        .Comment.Visible = True
                        .Comment.Shape.Left = .Left - .Comment.Shape.Width
                        .Comment.Shape.Top = .Top - .Comment.Shape.Height
                    End If
                End With
            ElseIf HasComment(oPrevObj) Then
                oPrevObj.Comment.Visible = False
            End If
        End If
        Set oPrevObj = oObj
        DoEvents
    Loop
 
End Sub

Regards.
 
Upvote 0
I placed it in ThisWorkbook and the coding crashes at:

Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

error message is:

"compile error- Only comments may appear after End sub, End function, or End property"

?

thx. again
 
Last edited:
Upvote 0
Paste all the code in a regular module.
 
Upvote 0
the coding is starting to come around :) what if I only want it to reposition the comments in sheet1 and leave the other comments in the other sheets alone ( ie: let excel place them automatically for me ) how would the coding lool like then and where would I place it? thx. again
 
Upvote 0
the coding is starting to come around :) what if I only want it to reposition the comments in sheet1 and leave the other comments in the other sheets alone ( ie: let excel place them automatically for me ) how would the coding lool like then and where would I place it? thx. again

Try this variation :

The code is to be placed in the WorkBook Module.

Code:
Option Explicit
 
Private WithEvents ShtEvents As Worksheet
 
Private bXitLoop As Boolean
 
Private Type POINTAPI
    x As Long
    Y As Long
End Type
 
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Private Sub ShtEvents_Activate()
 
    Call PositionComments
 
End Sub
 
Private Sub ShtEvents_Deactivate()
 
    bXitLoop = True
 
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
    bXitLoop = True
 
End Sub
 
Private Sub Workbook_Open()
 
    Set ShtEvents = Sheets("Sheet1")
    If ActiveSheet Is Sheets("Sheet1") Then
        Call PositionComments
    End If
    
End Sub

Private Function HasComment(Target As Range) As Boolean
 
    Dim oCmmt            As Comment
    On Error Resume Next
    Set oCmmt = Target.Comment
    If Not oCmmt Is Nothing Then HasComment = True
 
End Function
 
Private Sub PositionComments()
 
    Dim tPt              As POINTAPI
    Static oPrevObj      As Object
    Dim oObj             As Object
    
    On Error Resume Next
    
    bXitLoop = False
    Do
        GetCursorPos tPt
        Set oObj = _
        Application.ActiveWindow.RangeFromPoint(tPt.x, tPt.Y)
        If TypeName(oObj) = "Range" Then
            If HasComment(oObj) Then
                With oObj
                    If oPrevObj.Address <> .Address Then
                        .Comment.Visible = True
                        .Comment.Shape.Left = .Left - .Comment.Shape.Width
                        .Comment.Shape.Top = .Top - .Comment.Shape.Height
                    End If
                End With
            ElseIf HasComment(oPrevObj) Then
                oPrevObj.Comment.Visible = False
            End If
        End If
        Set oPrevObj = oObj
        DoEvents
        
    Loop Until bXitLoop
 
End Sub

Regards.
 
Upvote 0

Forum statistics

Threads
1,215,064
Messages
6,122,941
Members
449,094
Latest member
teemeren

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top