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.
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
Mon très mauvais; ajoutez Exit Sub après 'Application.ScreenUpdating = True'. Je vais mettre à jour la réponse. – Excelosaurus