Erreur de d'exécution '13'

[bimbam]

Bonjour

Malgré plusieurs recherches et essais des solutions lues, j'ai toujours un pb avec un code VBA. Lorsque que j'exécute mon fichier excel, un message d'erreur apparaît :
"Erreur d' exécution '13'
Incompatibilité de type "

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range, DerLg As Long, Contenu As String
Set Plage = Range("P5:P" & Range("P" & Rows.Count).End(xlUp).Row)
DerLg = Sheets("Archive").Range("P" & Rows.Count).End(xlUp).Row + 1
If Not Intersect(Target, Plage) Is Nothing And Target.Count = 1 Then
  If Target.Value = "x" Then
    Target.EntireRow.Copy Destination:=Sheets("Archive").Range("A" & DerLg)
    Target.EntireRow.Delete
    MsgBox "Ligne archivée ", vbInformation
  End If
End If
 
 'colonne à "surveiller" (ici colonne A)
 If Target.Column = 1 Then

  '  pour vérifier si la saisie n'existe pas déjà dans la colonne
  If Application.WorksheetFunction. _
    CountIf(Range("A:A"), Target.Value) > 1 Then

   MsgBox "OT déjà créer dans la liste"
   Target.Value = ""
   Target.Select
  End If
 End If
End Sub

Si j'isole le code qui permet de contrôler la répétition sur un fichier vierge, cela fonctionne.

En pièce jointe il y a le fichier alléger sur lequel je travail.

Merci d'avance.

 

[Paf]

Re : Erreur de d'exécution '13'

Bonjour

La pièce jointe ?

Peut-être y a t il des cellules fusionnées ?

A+

 

[bimbam]

Re : Erreur de d'exécution '13'

Bonjour

Désolé pour l'oubli de la pièce jointe.

Concernant les cellules fusionnées, affectivement il y en a, mais la mise en forme du tableau est identique entre le tableau de suivi et le tableau d'archivage.

Merci pour le coup de main.

 

[Iznogood1]

Re : Erreur de d'exécution '13'

BimBam,

quand tu effaces la ligne de l'onglet "kemone" pour l'archiver, tu déclenches l’événement Worksheet_Change.
Target pointe alors sur une ligne complète.

Plus loin, pour éviter les doublons, tu tentes de lire la propriété "Target.Value".
Or cette propriété n'a pas de sens si Target n'est pas une cellule unique.

D'où l'erreur 13.


Ton code comporte un second problème :
> il contrôle la fin d'une tâche pour l'archiver
> il contrôle l'absence de doublon

Quand tu archives une ligne, tu la copies dans la feuille "Archive", puis la supprimes de la feuille "kemone".
Tu contrôles ensuite l'absence de doublon.
Or, si tu as supprimé la ligne pour l'archiver, "Target" ne pointes plus sur aucune plage.
Ton code retoune alors une erreur.

Solution :
Inverser tes deux parties de code et désactiver le déclenchement des événements lors de la suppression d'une ligne pour archivage.

Private Sub Worksheet_Change(ByVal Target As Range)
  
  Dim Plage As Range, DerLg As Long, Contenu As String
  
  'colonne à "surveiller" (ici colonne A)
  If Target.Column = 1 Then
  'pour vérifier si la saisie n'existe pas déjà dans la colonne
    If Application.WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then
      MsgBox "OT déjà créer dans la liste"
      Target.Value = ""
      Target.Select
    End If
  End If
  
  'Archivage
  Set Plage = Range("P5:P" & Range("P" & Rows.Count).End(xlUp).Row)
  DerLg = Sheets("Archive").Range("P" & Rows.Count).End(xlUp).Row + 1
  If Not Intersect(Target, Plage) Is Nothing And Target.Count = 1 Then
    If Target.Value = "x" Then
      Target.EntireRow.Copy Destination:=Sheets("Archive").Range("A" & DerLg)
      Application.EnableEvents = False 'Désactiver les évênements
      Target.EntireRow.Delete
      Application.EnableEvents = True  'Réactiver les évênements
      MsgBox "Ligne archivée ", vbInformation
    End If
  End If

End Sub

 

[bimbam]

Re : Erreur de d'exécution '13'

Bonjour Iznogood1

Merci de ton aide cela fonctionne nettement mieux.

Etant novice en VBA, comment connaitre l'ordre lorsqu'il y a plusieurs code ? Est-ce qu'il y a une (des) règle(s) d'écriture ou est-ce simplement de la logique ?

Merci encore.

 

[Iznogood1]

Re : Erreur de d'exécution '13'

Pas de règle à ma connaissance.
Quelques bonnes pratiques...

Les plus fondamentales :

• utiliser Option Explicit (évite bien des erreurs en obligeant à déclarer les variables)
• séparer son code en fonctions "simples"
• éviter d'utiliser des variables globales

Ensuite, il existe toujours plusieurs solutions pour arriver au même résultat.
Ainsi, voici un code légèrement différent (pas "mieux") du tien qui fait la même chose :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  
  If Not Intersect(Target, Range("A5:A65536")) Is Nothing And Target.Columns.Count = 1 Then checkOT Target
  
  If Not Intersect(Target, Range("P5:P65536")) Is Nothing And Target.Columns.Count = 1 Then archiveLigne Target
End Sub

Private Sub checkOT(r As Range)
  Dim c As Range
  If r.value = "" Then Exit Sub
  If Evaluate("=Sumproduct((A:A=" & r.value & ")*1)") > 1 Then
    MsgBox "OT déjà créer dans la liste"
    r.ClearContents
    r.Select
  End If
End Sub

Private Sub archiveLigne(r As Range)
  If r.value = "" Then Exit Sub
  With r.EntireRow
    .Copy Destination:=Feuil6.Range("A" & Feuil6.[A1].CurrentRegion.Rows.Count)
    .Delete
  End With
  MsgBox "Ligne archivée ", vbInformation
End Sub