2017-10-18 5 views
0

J'ai le code suivant qui se déclenche via Worksheet_SelectionChange. Cependant, il semble que les commentaires soient également supprimés. Comment puis-je garder des commentaires?Supprimer les zones de texte mais conserver les commentaires

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

Répondre

0

Vous pouvez faire quelque chose le long de ces lignes:

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 

Je ne sais pas ce que vous voulez faire en testant Target = "" mais il ne fonctionnera pas s'il y a plus de 1 cellule Cible. Faites le moi savoir et je modifierai ma réponse.

+0

Obtention d'une boîte de message 'resume sans erreur 'suivie d'un message vide qui se répète indéfiniment. 'dicCommentNames (oComment.Shape.Name)' devrait être une itération pour le paramètre au lieu de '.name' puis' = .name'? – zero

+0

Mon très mauvais; ajoutez Exit Sub après 'Application.ScreenUpdating = True'. Je vais mettre à jour la réponse. – Excelosaurus