Erreur d’exécution '6'

Question

Bonjour,
J'ai un Userform U25 Qui contient
-TextBox1
-TextBox2
-ListView1
Je souhaites ajouter des items par le U25 à la feuille excel BDT, ci dessous ce que j'ai écrit mais j'ai comme code d'erreur '6' Dépassement de capacité.

Private Sub BtNouveau_Click()
TextBox1.Enabled = True
TextBox2.Enabled = True
TextBox1.SetFocus
End Sub

Private Sub BtValider_Click()
Dim i As Integer
For i = 1 To Range("a:a").End(xlDown).Row
ActiveCell.End(xlDown).Select
If UCase(TextBox1.Text) = UCase(Cells(i, 1).Text) And TextBox2 = "" Then

MsgBox "Ce Code est Déja Attribué":
TextBox1 = ""
TextBox2 = ""
Exit Sub
Else
If UCase(TextBox1.Text) = UCase(Cells(i, 1).Text) And TextBox2 <> "" Then
Sheets("BDT").Cells(i, 1).Value = Me.TextBox1.Value
Sheets("BDT").Cells(i, 2).Value = Me.TextBox2.Value
MsgBox "Modification Effectué":
TextBox1 = ""
TextBox2 = ""
Exit Sub
End If
End If
Next i
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 1).Offset(1, 1).Select
i = i + 1
Loop
Sheets("BDT").Cells(i, 1).Value = Me.TextBox1.Value
Sheets("BDT").Cells(i, 2).Value = Me.TextBox2.Value

If MsgBox("Confirmez-Vous l'ajout de cet Aricle?", vbYesNo, "Confirmation") = vbYes Then
End If
TextBox1 = ""
TextBox2 = ""
End Sub

EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).

Explications disponibles ici :ICI

Merci d'y penser dans tes prochains messages.
Jordane45

jordane45 · Answer

Bonjour,

 
Pour commencer.. au lieu de chercher une cellule via une boucle de plusieurs milliers de lignes... il serait préférable d'utiliser la méthode FIND
https://forums.commentcamarche.net/forum/affich-37621992-methode-find-dans-vba-recherche-de-donnees-sous-excel

yg_be · Answer

bonsoir, sur quelle ligne as-tu l'erreur?
suggestion: Dim i As Long

jordane45 · Answer

Re bonjour,

Avec le code suivant, je pense que tu n'auras plus de soucis.

Je l'ai découpé en sub et fonctions histoire de le rendre plus lisible et plus propre...

Private Sub BtValider_Click()
    Dim ligne As Long
    Dim valCh As String
    Dim sh As Worksheet
    Dim valExist As Long
    Set sh = Worksheets("BDT")
    
    valCh = Me.TextBox1.Value
    valExist = chercheVal(sh, valCh)
   
    If valExist Then
        If TextBox2.Value = "" Then
            MsgBox "Ce Code est Déja Attribué":
            Me.TextBox1 = ""
            Me.TextBox2 = ""
        ElseIf TextBox2.Value <> "" Then
            Call modifier(sh, valExist)
        End If
    Else
         Call ajouter(sh)
    End If
End Sub

Function chercheVal(sh As Worksheet, Valeur_Cherchee As String)
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    
    'On cherche dans la première colonne de la feuille sh
    Set PlageDeRecherche = sh.Columns(1)
    
    'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
    Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

'traitement de l'erreur possible : Si on ne trouve rien :
    If Trouve Is Nothing Then
        'ici, traitement pour le cas où la valeur n'est pas trouvée
        chercheVal = False
    Else
        'ici, traitement pour le cas où la valeur est trouvée
        chercheVal = Trouve.Row 'retourne la ligne concernée
    End If
End Function

Sub ajouter(sh As Worksheet)
    Dim LastRow As Long
    LastRow = Derniere_Ligne(sh)
    If MsgBox("Confirmez-Vous l'ajout de cet Aricle?", vbYesNo, "Confirmation") = vbYes Then
        sh.Cells(LastRow + 1, 1).Value = Me.TextBox1.Value
        sh.Cells(LastRow + 1, 2).Value = Me.TextBox2.Value
    End If
End Sub

Sub modifier(sh As Worksheet, ligne As Long)
    sh.Cells(ligne, 1).Value = Me.TextBox1.Value
    sh.Cells(ligne, 2).Value = Me.TextBox2.Value
    MsgBox "Modification Effectuée"
End Sub

Function Derniere_Ligne(sh As Worksheet) As Long '
    Derniere_Ligne = sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
End Function

Cordialement, 
Jordane

Erreur d’exécution '6'

Explications disponibles ici :ICI

3 réponses

Discussions similaires

Newsletters