XL 2016 Erreur d'exécution 13: incompatibilité de type

KTM · 25 Février 2021

Bonjour chers tous
Mon code ci dessous me renvoie une erreur 13 à la ligne 5.
Comment corriger ? Merci

VB:

Dim n As Variant   
With Sheets("Grille_de_Dispensation")
    If .Range("A" & Rows.Count).End(xlUp).Row > 1 Then
    n = Application.Match(TextBox1, .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row + 1), 0)
            If Not IsError(n) And .Range("B" & n) = CDate([TB!B11]) Then
If MsgBox("Le Patient " & .Cells(n, 1) & " a reçu une dotation de " & .Cells(n, 3) & " le " & .Cells(n, 14) & _
"Voulez-vous le réenregistrer pour un autre passage ? ", vbYesNo + 48) = vbNo Then TextBox1 = "": Exit Sub
            End If
    End If
End With

Staple1600 · 25 Février 2021

Bonsoir le fil, KTM

=>KTM
Test OK sur mon fichier test

VB:

Private Sub CommandButton1_Click()
Dim n As Long
With Sheets("Grille_de_Dispensation")
If .Range("A" & Rows.Count).End(xlUp).Row > 1 Then
If Len(TextBox1) = 0 Then Exit Sub
n = Application.Match(TextBox1, .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row + 1), 0)
If Not IsError(n) And .Range("B" & n) = CDate([TB!B11]) Then
If MsgBox("Le Patient " & .Cells(n, 1) & " a reçu une dotation de " & .Cells(n, 3) & " le " & .Cells(n, 14) _
& Chr(13) & "Voulez-vous le réenregistrer pour un autre passage ? ", vbYesNo + 48) = vbNo Then TextBox1 = ""
Exit Sub
End If
End If
End With
End Sub

Reste à voir ce qu'il en sera sur ton fichier.

sylvanu · 25 Février 2021

Bonsoir KTM, Staple,
Vous pouvez supprimer l'erreur 13 en précisant l'origine de Textbox1 en mettant un point devant, et en faisant un test spécifique sur n. En fait l'erreur vient de .Range("B" & n) , comme n peut être en erreur alors .Range("B" & n) est en erreur et n'est pas protégé par un Iserror.

Code:

Sub essai()
Dim n As Variant
With Sheets("Grille_de_Dispensation")
    If .Range("A" & Rows.Count).End(xlUp).Row > 1 Then
        n = Application.Match(.TextBox1.Value, .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row + 1), 0)
        If IsError(n) Then Exit Sub
        If .Range("B" & n) = CDate([TB!B11]) Then
            If MsgBox("Le Patient " & .Cells(n, 1) & " a reçu une dotation de " & .Cells(n, 3) & " le " & .Cells(n, 14) & _
                        Chr(10) & "Voulez-vous le réenregistrer pour un autre passage ? ", vbYesNo + 48) = vbNo Then TextBox1 = "": Exit Sub
        End If
    End If
End With
End Sub

XL 2016 Erreur d'exécution 13: incompatibilité de type

KTM

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

Discussions similaires