XL 2019 Erreur définie par l'application ou par l'objet "1004"

terrier · 11 Mars 2021

Bonsoir je reviens vers vous car je suis bloqué devant un beugue depuis 5 jours et j'arrive pas à le résoudre;
je souhaite récupérer des donner de ma base vers une listbox et labels après quelque semaine de travaille l'erreur à changé et mon projet évolu sauf qu'il s'arrette mnt sur toutes les ligne "= Cells(Csl, 11).Value", alors pour ce la je viens solliciter votre aide :

VB:

Private Sub btn_charger_Click()
Dim i As Integer
Dim C As Range
Dim Csl As Integer
Dim wksCheck As Worksheet

'Procédure permettant de sauvegarder l'ajout d'un nouveau client dans la base Source

        'On teste que les contrôles ont bien été saisie
        If Me.txt_commande = "Livr-00" Then
            Me.lblmessage = "Veuillez saisir numéro de Bon de livraison SVP!"
            Me.txt_commande.SetFocus


        Else
        
                
                        Set wksCheck = ActiveWorkbook.Sheets("Check")
                    
                        
                        Set C = Cells.Find(What:=Me.txt_commande.Value, After:=ActiveCell, LookIn:= _
                        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
                        xlNext, MatchCase:=False, SearchFormat:=False) 
                        C.Select
                    If Not C Is Nothing Then
                    Me.lblmessage = "ok"
                        With Me.List_livr
                        For i = 0 To .ListCount - 1
                        If .List(i, 0) = Cells(Csl, 11).Value Then
                        MsgBox "Ce produit est déja sur la liste"
                        Exit Sub
                        End If
                        Next i
                        .AddItem
                        .List(memoire, 0) = Cells(Csl, 11).Value
                        .List(memoire, 1) = Cells(Csl, 12).Value
                        End With
                        memoire = memoire + 1
                        Me.Txt_article = ""
                        Me.Txt_quantité = ""
                        Me.lbl_nomprenom = Cells(Csl, 4).Value
                        Me.lbl_governat = Cells(Csl, 5).Value
                        Me.lbl_ville = Cells(Csl, 6).Value
                        Me.Lbl_adresse = Cells(Csl, 7).Value
                        Me.lbl_tel1 = Cells(Csl, 8).Value
                        Me.lbl_tel2 = Cells(Csl, 9).Value
                        Me.Txt_article = Cells(Csl, 11).Value
                        Me.Txt_quantité = Cells(Csl, 12).Value
        

                    Else
                    Me.lblmessage = "Non Disponible"
                    Exit Sub
                    End If


        End If
End Sub

soan · 11 Mars 2021

Bonjour terrier,

je te propose ce code VBA (non testé, « à l'arrache ») :

VB:

Private Sub btn_charger_Click()
  Dim wksCheck As Worksheet, C As Range, i&
  'sauvegarder l'ajout d'un nouveau client dans la base Source
  'on teste que les contrôles ont bien été saisis
  If txt_commande = "Livr-00" Then
    lblmessage = "Veuillez saisir un numéro de Bon de livraison SVP!"
    txt_commande.SetFocus: Exit Sub
  End If
  Set wksCheck = ActiveWorkbook.Worksheets("Check")
  Set C = wksCheck.Cells.Find(txt_commande, , -4163, 2, 1)
  If C Is Nothing Then lblmessage = "Non Disponible": Exit Sub
  lblmessage = "ok": Set C = wksCheck.Cells(C.Row, 4)
  With List_livr
    For i = 0 To .ListCount - 1
      If .List(i, 0) = Cells(Csl, 11) Then _
        MsgBox "Ce produit est déja sur la liste": Exit Sub
    Next i
    Txt_article = C.Offset(, 7)
    Txt_quantité = C.Offset(, 8)
    .AddItem
    .List(memoire, 0) = Txt_article
    .List(memoire, 1) = Txt_quantité
    memoire = memoire + 1
  End With
  lbl_nomprenom = C
  lbl_governat = C.Offset(, 1)
  lbl_ville = C.Offset(, 2)
  Lbl_adresse = C.Offset(, 3)
  lbl_tel1 = C.Offset(, 4)
  lbl_tel2 = C.Offset(, 5)
End Sub

soan

terrier · 12 Mars 2021

soan à dit:

Bonjour terrier,

je te propose ce code VBA (non testé, « à l'arrache ») :

VB:

Private Sub btn_charger_Click()
  Dim wksCheck As Worksheet, C As Range, i&
  'sauvegarder l'ajout d'un nouveau client dans la base Source
  'on teste que les contrôles ont bien été saisis
  If txt_commande = "Livr-00" Then
    lblmessage = "Veuillez saisir un numéro de Bon de livraison SVP!"
    txt_commande.SetFocus: Exit Sub
  End If
  Set wksCheck = ActiveWorkbook.Worksheets("Check")
  Set C = wksCheck.Cells.Find(txt_commande, , -4163, 2, 1)
  If C Is Nothing Then lblmessage = "Non Disponible": Exit Sub
  lblmessage = "ok": Set C = wksCheck.Cells(C.Row, 4)
  With List_livr
    For i = 0 To .ListCount - 1
      If .List(i, 0) = Cells(Csl, 11) Then _
        MsgBox "Ce produit est déja sur la liste": Exit Sub
    Next i
    Txt_article = C.Offset(, 7)
    Txt_quantité = C.Offset(, 8)
    .AddItem
    .List(memoire, 0) = Txt_article
    .List(memoire, 1) = Txt_quantité
    memoire = memoire + 1
  End With
  lbl_nomprenom = C
  lbl_governat = C.Offset(, 1)
  lbl_ville = C.Offset(, 2)
  Lbl_adresse = C.Offset(, 3)
  lbl_tel1 = C.Offset(, 4)
  lbl_tel2 = C.Offset(, 5)
End Sub

soan

Bonjour Soan
Je suis désolé pour le retard et je vous remercie infiniment pour l'effort, votr code m'a permis de se rappeler de l'outil offset qui m'a passé sous les yeux.
Voici le code finale sans beugue:

VB:

Private Sub btn_charger_Click()
Dim wksCheck As Worksheet, C As Range, i&
'Procédure permettant de sauvegarder l'ajout d'un nouveau retour
    'On teste que les contrôles ont bien été saisie
    If Me.txt_commande = "Livr-00" Then
    Me.lblmessage = "Veuillez saisir numéro de Bon de livraison SVP!"
    Me.txt_commande.SetFocus
    Else
    Set wksCheck = ActiveWorkbook.Worksheets("Check")
    Set C = Cells.Find(What:=Me.txt_commande.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:= _
    xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not C Is Nothing Then
        C.Select
        Me.lblmessage = "ok"
            With Me.List_livr
            For i = 0 To .ListCount - 1
            If .List(i, 0) = C.Offset(, 8).Value Then
            Me.lblmessage = "Ce produit est déja sur la liste"
            Exit Sub
            End If
            Next i
            .AddItem
            .List(memoire, 0) = C.Offset(, 8).Value
            .List(memoire, 1) = C.Offset(, 9).Value
            End With
            memoire = memoire + 1
            Me.Txt_article = ""
            Me.Txt_quantité = ""
            Me.txt_commande.Enabled = False
            Me.lbl_nomprenom = C.Offset(, 1).Value
            Me.lbl_governat = C.Offset(, 2).Value
            Me.lbl_ville = C.Offset(, 3).Value
            Me.Lbl_adresse = C.Offset(, 4).Value
            Me.lbl_tel1 = C.Offset(, 5).Value
            Me.lbl_tel2 = C.Offset(, 6).Value
            Me.Txt_article = C.Offset(, 8).Value
            Me.Txt_quantité = C.Offset(, 9).Value
            Else
            Me.lblmessage = "Non Disponible"
            Exit Sub
        End If
    End If
End Sub

J'ai bien préféré "If Not C Is Nothing" que "If C Is Nothing" pour des simples raison :
-Une livraison peut contenir plusieurs articles et je devais tout charger dans la list_liv (ce qui n'est pas claire, puisque vous n'avais pas la BDD), dans le cas ou la référence de la liv "txt_commande existe donc je continue la procédure, si non
- je laisse l'erreur en dernier et c'est plus facile de traiter.
encore merci beaucoup

soan · 12 Mars 2021

Bonjour terrier,

une petite info comme ça, juste en passant : dans ton code final, je vois plein de « Me. » ; alors que je les avais volontairement tous enlevés ; pourquoi ? car ta sub btn_charger_Click() est placée dans le module de code VBA du UserForm, et dans celui-ci, tous les contrôles de ce UF sont automatiquement référencés par lui-même ! (c'est implicite) ; aussi, dans un tel module, c'est tout à fait inutile d'utiliser « Me. » ; et je me sers de « Me » uniquement quand il faut fermer le UF avec « Unload Me » ; note que quand on ferme un UF, on le décharge de la mémoire (la RAM) ; c'est pourquoi c'est bien « Unload Me » et pas « Close Me » : ainsi, ça rappelle que la mémoire est libérée (mais t'inquiètes pas : elle va quand même rester dans ton PC, elle va pas aller prendre des vacances à la plage pendant que toi tu trimes au boulot ! ).

soan

terrier · 13 Mars 2021

Bonjour Soan,
C'est très bon à savoir merci pour les précieux conseils.

XL 2019 Erreur définie par l'application ou par l'objet "1004"

terrier

XLDnaute Junior

soan

XLDnaute Barbatruc

terrier

XLDnaute Junior

soan

XLDnaute Barbatruc

terrier

XLDnaute Junior

Discussions similaires