2017-10-18 9 views
0

私は次のコードをWorksheet_SelectionChange経由で発行しています。しかし、コメントも削除されているように見えます。どうすればコメントを残すことができますか?テキストボックスを削除してもコメントを残す

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

答えて

0

あなたはこれらの線に沿って何かを行うことができます:

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つのセル内に存在する場合は動作しません。ターゲット。私に知らせてください、私は私の答えを修正します。

+0

'resume without error'メッセージボックスの後に無限に繰り返される空白のメッセージボックスが続きます。 'dicCommentNames(oComment.Shape.Name)'は '.name'、' = .name'の代わりにパラメータの反復でなければなりませんか? – zero

+0

私の非常に悪い; 'Application.ScreenUpdating = True'の後にExit Subを追加してください。私は答えを更新します。 – Excelosaurus

関連する問題