Focus and Close Comment Box with VBA

[Drofidnas]

Hi

I've got some code that invokes the comment box for the selected cell when double clicked. The reason for this is I'm using right click to mark/umark cells.

I can get the comment to open but I'd like to focus the cursor in the box if possible and at the very least close the box when it is deselected.

Is this achievable?

Setting cmt.Visible to False just adds a comment with no option to edit.

Thanks for any help.

Chris

Private Sub Worksheet_Beforedoubleclick(ByVal Target As Range, Cancel As Boolean)

errTrap:
If Target.Column >= 4 Then
Cancel = True

Dim cmt As Comment
Set cmt = ActiveCell.Comment
If cmt Is Nothing Then
Set cmt = ActiveCell.AddComment
cmt.Text Text:="Milestone date:" & vbLf
End If

cmt.Visible = True

End If

End Sub

EDIT

Adding

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.DisplayCommentIndicator = xlCommentIndicatorOnly

End Sub

closes all comment boxes so that seems to work, just the focusing part would be good

 

[Jaafar Tribak]

See if this works for you :

Code goes in the Worksheet module

Option Explicit

Private WithEvents wb As Workbook


#If VBA7 Then
    Private Declare PtrSafe Function GetInputState Lib "user32" () As Long
#Else
    Private Declare Function GetInputState Lib "user32" () As Long
#End If


Private bXitLoop As Boolean


Private Sub Worksheet_Beforedoubleclick(ByVal Target As Range, Cancel As Boolean)
    Dim cmt As Comment
    
    If Target.Column >= 4 Then
        Cancel = True
        Set wb = ThisWorkbook
        Set cmt = ActiveCell.Comment
        If cmt Is Nothing Then
            Set cmt = ActiveCell.AddComment
            With cmt
                .Text Text:="Milestone date :" & vbLf
                .Visible = True
                .Shape.Select
                bXitLoop = False
                Do: MyDoEvents: Loop Until TypeName(Selection) <> "TextBox" Or bXitLoop
                .Visible = False
            End With
        End If
    End If
End Sub


Private Sub MyDoEvents()
    If GetInputState() <> 0 Then DoEvents
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    bXitLoop = True
End Sub
Private Sub wb_BeforeClose(Cancel As Boolean)
    bXitLoop = True
End Sub

BTW, you don't need to use Application.DisplayCommentIndicator = xlCommentIndicatorOnly as that will affect all the Comments in all workbooks throughout the entire application