Incompatibilité de type (Erreur d'exécution '13')

Bonjour,

J'ai un erreur d'incompatibilité de type (Erreur d'exécution '13') et cela efface le contenu de la ligne suivante lorsque je modifie mon choix dans la liste déroulante.

Pouvez-vous m'aider à résoudre cet erreur ?

Merci beaucoup de votre collaboration !

Voici mon code :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E16:E1000")) Is Nothing Then
        Range(Cells(Target.Row, "F"), Cells(Target.Row + 1, "M")).ClearContents
        'Si modification dans la plage M16:M1000
    ElseIf Not Intersect(Target, Range("M16:M1000")) Is Nothing Then
        'Si le choix est oui
        If Target.Value = "Oui" Then
            'Désactiver les évènements
            Application.EnableEvents = False
            'On insère une ligne en dessous
            ActiveSheet.Rows(Target.Row + 1).EntireRow.Insert shift:=xlDown
            'Copie du bloc de vérification
            Range(Cells(Target.Row, "O"), Cells(Target.Row, "W")).Copy
            Cells(Target.Row + 1, "O").Select
            ActiveSheet.Paste
            'Copie du début de ligne
            Range(Cells(Target.Row, "D"), Cells(Target.Row, "E")).Copy
            Cells(Target.Row + 1, "D").Select
            ActiveSheet.Paste
            'Enlever la sélection de la copie
            Application.CutCopyMode = False
            'Enlever la bordure supérieure des cellule B et C.
            Range(Cells(Target.Row + 1, "B"), Cells(Target.Row + 1, "C")).Borders(xlEdgeTop).LineStyle = Excel.XlLineStyle.xlLineStyleNone
            'Dessiner les bordures au cas où ce serait la dernière ligne du tableau
            If Cells(Target.Row + 2, "D").Value = "" Then
                Dim Ligne As Excel.Range
                Set Ligne = Range(Cells(Target.Row + 1, "B"), Cells(Target.Row + 1, "M"))
                Ligne.Borders(xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlInsideVertical).LineStyle = Excel.XlLineStyle.xlContinuous
            End If
            'Se positionner pour la prochaine saisie
            Cells(Target.Row + 1, "F").Select
            'Réactiver les évènements
            Application.EnableEvents = True
        ElseIf Target.Value = "Non" Then
            If Cells(Target.Row, "D").Value = Cells(Target.Row + 1, "D").Value Then
                'Désactiver les évènements
                Application.EnableEvents = False
                'On insère une ligne en dessous
                ActiveSheet.Rows(Target.Row + 1).EntireRow.Delete shift:=xlUp
                'Redessiner le cadre dans le cas de la dernière ligne
                If Cells(Target.Row + 1, "D").Value = "" Then
                    Range(Cells(Target.Row, "B"), Cells(Target.Row, "C")).Borders(xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
                End If
                'Réactiver les évènements
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Bonjour Catherine,

Quand tu fais débogage, quelle est la ligne du code en erreur ?
L'erreur 13 est une erreur générique qui dit simplement que la donnée attendue ne correspond pas a ce que le programme attend, par exemple un texte au lieu d'un nombre ou d'une date...

Benead

Bonjour, sans fichier beaucoup de question.

comme par exemple le mode de saisie dans cette cellule ?

If Target.Value = "Oui" Then ....

C'est une liste de choix un sélecteur ? si vous tapez directement dans la cellule alors effectivement çà risque de buguer avec l'évenement :

Private Sub Worksheet_Change(ByVal Target As Range)

Si vous commencez à tapez le O de oui la macro se déclenche car la cellule a été modifiée mais le code sera en erreur car vous n'avez pas le temps d'écrire le reste.

Personnellement je fais toutes mes macros dans des modules. Une fois testée est toutes ok alors si besoin de déclenchement dans une feuille alors

dans le worksheet de la feuille :

if condition 1 ok then call macro1

if condition 2 ok then call macro2

....

Bonjour,

Le déboggage me donne sur la ligne en jaune

bonjour,

je pense que ton problème vient de la gestion des événements, (le clearcontents déclenche l'événement worksheet_change avec comme paramètres une plage de valeurs. dans ce cas target.value te renvoie une erreur 13).

proposition de correction de tes premières lignes

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E16:E1000")) Is Nothing Then
application.enableevents=false
        Range(Cells(Target.Row, "F"), Cells(Target.Row + 1, "M")).ClearContents
application.enableevents=true
        'Si modification dans la plage M16:M1000

Ton code pourrait être bon mais il n'y a plus rien qui fonctionne dans la deuxième partie de mon code et il faut que ça fonctionne aussi:

Beau casse-tête…

  ElseIf Not Intersect(Target, Range("M16:M1000")) Is Nothing Then
        'Si le choix est oui
        If Target.Value = "Oui" Then
            'Désactiver les évènements
            Application.EnableEvents = False
            'On insère une ligne en dessous
            ActiveSheet.Rows(Target.Row + 1).EntireRow.Insert shift:=xlDown
            'Copie du bloc de vérification
            Range(Cells(Target.Row, "O"), Cells(Target.Row, "W")).Copy
            Cells(Target.Row + 1, "O").Select
            ActiveSheet.Paste
            'Copie du début de ligne
            Range(Cells(Target.Row, "D"), Cells(Target.Row, "E")).Copy
            Cells(Target.Row + 1, "D").Select
            ActiveSheet.Paste
            'Enlever la sélection de la copie
            Application.CutCopyMode = False
            'Enlever la bordure supérieure des cellule B et C.
            Range(Cells(Target.Row + 1, "B"), Cells(Target.Row + 1, "C")).Borders(xlEdgeTop).LineStyle = Excel.XlLineStyle.xlLineStyleNone
            'Dessiner les bordures au cas où ce serait la dernière ligne du tableau
            If Cells(Target.Row + 2, "D").Value = "" Then
                Dim Ligne As Excel.Range
                Set Ligne = Range(Cells(Target.Row + 1, "B"), Cells(Target.Row + 1, "M"))
                Ligne.Borders(xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlInsideVertical).LineStyle = Excel.XlLineStyle.xlContinuous
            End If
            'Se positionner pour la prochaine saisie
            Cells(Target.Row + 1, "F").Select
            'Réactiver les évènements
            Application.EnableEvents = True
        ElseIf Target.Value = "Non" Then
            If Cells(Target.Row, "D").Value = Cells(Target.Row + 1, "D").Value Then
                'Désactiver les évènements
                Application.EnableEvents = False
                'On insère une ligne en dessous
                ActiveSheet.Rows(Target.Row + 1).EntireRow.Delete shift:=xlUp
                'Redessiner le cadre dans le cas de la dernière ligne
                If Cells(Target.Row + 1, "D").Value = "" Then
                    Range(Cells(Target.Row, "B"), Cells(Target.Row, "C")).Borders(xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
                End If
                'Réactiver les évènements
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Je rejoins h2so4, le problème vient l'effacement de la plage, et en désactivant les événements, tu règleras le problème.

En fait, le message s'affiche car quand tu effaces une plage de données, la variable Target qui est de type range est soit une seule cellule, soit plusieurs. Si Target = une cellule, Target.Value = la valeur de la cellule, donc on peut comparer la valeur avec 'Oui", par contre si Target = plusieurs cellules, alors Target.Value contient une table (valeur 1, valeur2...) qui contient l'ensemble des valeurs des cellules contenu dans Target, on compare donc une table avec une variable texte, Excel n'aime pas et il a bien raison.

Une autre alternative est de tester le nombre de cellules contenu dans Target : If Target.count=1 then, mais la désactivation des évènement est plus efficace et aussi plus rapide sur une grande plage d'effacement de cellules.

Benead

bonjour,

je n'ai rien changé dans la 2ème partie de ton code, j'ai fait l'hypothèse qu'il fonctionnait correctement et je ne vois pas en quoi la modification proposée affecte cette partie de ton code. Peut-être que suite à une erreur, le déclenchement de macros événementielles ne se fait plus. Essaie en réactivant les événements en exécutant cette procédure à mettre dans un nouveau module.

sub eventon()
application.enableevents=true
end if

Si cela ne fonctionne pas ainsi, merci de mettre ton fichier dans lequel cela "ne fonctionne pas"

Non, ça ne fonctionne toujours pas.

Et même que quand je sélectionne "Non", les cellules de la ligne suivante sont hachurées parce que j'ai dis quand c'est 'Non', ce doit être hachuré

Mon code est :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E16:E1000")) Is Nothing Then
Application.EnableEvents = False
        Range(Cells(Target.Row, "F"), Cells(Target.Row + 1, "M")).ClearContents
Application.EnableEvents = True
        'Si modification dans la plage M16:M1000
        ElseIf (Not Intersect(Target, Range("M16:M1000")) Is Nothing) And (Target.Count = 1) Then
        'Si le choix est oui
        If Target.Value = "Oui" Then
            'Désactiver les évènements
            Application.EnableEvents = False
            'On insère une ligne en dessous
            ActiveSheet.Rows(Target.Row + 1).EntireRow.Insert shift:=xlDown
            'Copie du bloc de vérification
            Range(Cells(Target.Row, "O"), Cells(Target.Row, "W")).Copy
            Cells(Target.Row + 1, "O").Select
            ActiveSheet.Paste
            'Copie du début de ligne
            Range(Cells(Target.Row, "D"), Cells(Target.Row, "E")).Copy
            Cells(Target.Row + 1, "D").Select
            ActiveSheet.Paste
            'Enlever la sélection de la copie
            Application.CutCopyMode = False
            'Enlever la bordure supérieure des cellule B et C.
            Range(Cells(Target.Row + 1, "B"), Cells(Target.Row + 1, "C")).Borders(xlEdgeTop).LineStyle = Excel.XlLineStyle.xlLineStyleNone
            'Dessiner les bordures au cas où ce serait la dernière ligne du tableau
            If Cells(Target.Row + 2, "D").Value = "" Then
                Dim Ligne As Excel.Range
                Set Ligne = Range(Cells(Target.Row + 1, "B"), Cells(Target.Row + 1, "M"))
                Ligne.Borders(xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous
                Ligne.Borders(xlInsideVertical).LineStyle = Excel.XlLineStyle.xlContinuous
            End If
            'Se positionner pour la prochaine saisie
            Cells(Target.Row + 1, "F").Select
            'Réactiver les évènements
            Application.EnableEvents = True
        ElseIf Target.Value = "Non" Then
            If Cells(Target.Row, "D").Value = Cells(Target.Row + 1, "D").Value Then
                'Désactiver les évènements
                Application.EnableEvents = False
                'On insère une ligne en dessous
                ActiveSheet.Rows(Target.Row + 1).EntireRow.Delete shift:=xlUp
                'Redessiner le cadre dans le cas de la dernière ligne
                If Cells(Target.Row + 1, "D").Value = "" Then
                    Range(Cells(Target.Row, "B"), Cells(Target.Row, "C")).Borders(xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous
                End If
                'Réactiver les évènements
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Bonjour,

Une petite contribution.

Cdlt.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

    On Error GoTo errHandler

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    If Not Intersect(Target, Me.Range("E16:E1000")) Is Nothing And Target.Count = 1 Then
        Target.Offset(, 1).Resize(1, 8).ClearContents
    End If

    If Not Intersect(Target, Me.Range("M16:M1000")) Is Nothing And Target.Count = 1 Then
        Select Case LCase(Target.Value)
            Case "oui":
                With Target
                    .Offset(1).EntireRow.Insert shift:=xlDown
                    .Offset(, 2).Resize(, 9).Copy Target.Offset(1, 2)
                    .Offset(, -9).Resize(, 2).Copy Target.Offset(1, -9)
                    .Offset(1, -11).Resize(, 2).Borders(xlEdgeTop).LineStyle = xlLineStyleNone
                End With
                If IsEmpty(Target.Offset(2, -9)) Then
                    Set rng = Target.Offset(1, -11).Resize(, 12)
                    With rng
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlInsideVertical).LineStyle = xlContinuous
                    End With
                End If
            Case "non"
                If Target.Offset(, -9).Value = Target.Offset(1, -9).Value Then
                    Target.Offset(1).EntireRow.Delete shift:=xlUp
                    If IsEmpty(Target.Offset(1, -9)) Then
                        Set rng = Target.Offset(, -11).Resize(, 12)
                        rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
                    End If
                End If
            Case Else:
        End Select
    End If

exitHandler:
    Set rng = Nothing
    Application.EnableEvents = True
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume exitHandler

End Sub

Tout fonctionne !

Il y a seulement la partie "Mise en forme conditionnelle" :

Quand on ajoute une nouvelle ligne, et qu'on change la première ligne en "Non", la mise en forme conditionnelle se fait aussi sur la deuxième ligne, est-ce qu'il y a moyen de contourner ce problème ?

Merci!