删除文本框但保留注释

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 = ""做什么，但如果有超过1个细胞将无法正常工作目标。让我知道，我会修改我的答案。