Astuces Excel
  1. Astuces Excel
  3. VBA Excel – Erreur définie par l'application ou définie par l'object
Intereting Posts
Comment ouvrir une version spécifique de Word 2007/2010 dans Excel Comment étendre le code Excel VBA suivant Comment extraire un text d'une table, mais la table a le même nom que d'autres tables? VBA, excel Modification de ma formule Excel actuelle VBA Rechercher des valeurs sur plusieurs feuilles et donner total Formatage VBA Excel Cell sur des jours spécifiques ouverts Erreur d'exécution Excel copyr et coller Excel VBA Comment append une colonne de valeur à un tableau? Automatiser l'ID avec les inputs de formulaire de l'user – Excel Excel VBA Macro Debugging – Application / Object-defined error (erreur 1004) Macro Excel pour searchr du text puis zone contextuelle si trouvé puis afficher le nombre de fois que le mot apparaît Impossible de lire la database ou l'object en lecture seule Comment utiliser xlrd pour écrire un file excel Comment enregistrez-vous un certificate sha256 avec une signature sha256 pour sécuriser le code Excel VBA Macro dans Excel 2013? Pièce jointe non envoyée avec Gmail et CDO dans Excel / VBA

VBA Excel – Erreur définie par l'application ou définie par l'object

Je suis en difficulté pour comprendre pourquoi j'avance l'erreur ci-dessus lorsque je lance ce code. Parfois, cela fonctionne, parfois, pas? Le code se trouve dans une feuille plutôt qu'un module et je pense que c'est peut-être le problème, mais le même code fonctionne bien dans une autre feuille du classur.

Quelqu'un peut-il me dire ce que je manque?

Merci. 

Sub DeleteRow() On Error GoTo error_handler Dim Button As Shape Dim CellinRowtoDelete As Range 'Run sub routine ClearSearchandFilter Application.ScreenUpdating = False 'Determine which row needs to be deleted ButtonLocation = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address Range(ButtonLocation).Select 'Select and delete buttons before deleting the row Set CellinRowtoDelete = ActiveCell For Each Button In ActiveSheet.Shapes If Not Application.Intersect(Range(Button.TopLeftCell.Address), CellinRowtoDelete) Is Nothing Then Button.Select Button.Delete End If Next 'Delete the row ActiveCell.EntireRow.Delete 'Re-format cells in row 8 with a red box incase the bottom has been removed by deleting row 9 Range("W8:AM8").Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Color = -16776961 .TintAndShade = 0 .Weight = xlMedium End With Range("X5").Select Application.ScreenUpdating = True Exit Sub Error_handler: MsgBox Err.Description End Sub

Tout d'abord, vous ne devriez pas utiliser .Activate , .Activate , ou quelque chose d' Active , vraiment. Il dérangera votre code plus qu'il ne l'aidera (à l'exception de quelques exemples).

Deuxièmement, au lieu de vérifier l'intersection avec une cellule, essayez de vérifier l'intersection avec la ligne entière. Comme vous supprimez tous les buttons de cette rangée de toute façon (si je vous ai bien compris), cela sera plus exact car même un centre hors-cellule sera supprimé. Cela peut sembler confus mais supporter avec moi.

Veuillez essayer le code suivant. 

 Sub DeleteRow() Dim Button As Shape Dim RowToDelete As Range 'Run sub routine ClearSearchandFilter Application.ScreenUpdating = False 'Determine which row needs to be deleted ButtonLocation = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address Set RowToDelete = Range(ButtonLocation).EntireRow 'Select and delete buttons before deleting the row For Each Button In ActiveSheet.Shapes If Not Application.Intersect(Range(Button.TopLeftCell.Address), RowToDelete) Is Nothing Then Button.Delete End If Next 'Delete the row RowToDelete.Delete 'Re-format cells in row 8 with a red box incase the bottom has been removed by deleting row 9 With Range("W8:AM8").Borders(xlEdgeBottom) .LineStyle = xlContinuous .Color = -16776961 .TintAndShade = 0 .Weight = xlMedium End With Application.ScreenUpdating = True End Sub

Faites-nous savoir quel est le résultat.