删除文本框但保留注释

Question

我有以下代码通过Worksheet_SelectionChange触发。但是，似乎评论也会被删除。我该如何保留评论？

If Intersect(Target, Range("B5:B34")) Is Nothing Or Target = "" Then
    For Each bx In ActiveSheet.TextBoxes
        bx.Delete
    Next
End If

Answer 1

你可以沿着这些方向做点什么：

Sub DeleteTextboxesButKeepComments
    Dim bx As Excel.TextBox
    Dim oComment As Excel.Comment
    Dim dicCommentNames As Object 'Scripting.Dictionary

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo errHandler

    'Build a dictionary of the worksheet's comment's shape names.
    Set dicCommentNames = CreateObject("Scripting.Dictionary")
    dicCommentNames.CompareMode = VbCompareMethod.vbBinaryCompare
    For Each oComment In Target.Worksheet.Comments
        dicCommentNames(oComment.Shape.Name) = True
    Next oComment

    If Intersect(Target, Target.Worksheet.Range("B5:B34")) Is Nothing Then 'Or Target = "" Then
        For Each bx In Target.Worksheet.TextBoxes
            'Avoid deleting textboxes whose name is among those used for comments.
            If Not dicCommentNames.Exists(bx.Name) Then
                bx.Delete
            End If
        Next
    End If

Cleanup:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Cleanup
End Sub

我不确定你想要通过测试Target = ""做什么，但如果Target中有超过1个单元格，它将不起作用。让我知道，我会修改我的答案。