Microsoft 365 Problème Débogage VBA

eric72

XLDnaute Occasionnel
Bonjour à tous,
J'ai une macro qui me pose un problème, lorsque j'utilise celle-ci elle fonctionne parfaitement 2 fois et la 3ème fois elle me fait un débogage de type erreur 1004 la méthode cells de l'objet worksheet à échoué ( à la ligne " .Cells(Derligne, 4) = IIf(Date_entree = 0, "", Date_entree") et je ne vois pas du tout pourquoi.
Avez vous une idée et pourquoi seulement 1 fois sur 3 :

Private Sub CommandButton1_Click()
Dim Date_entree As Date
Dim Date_sortie As Date
Dim Derligne As Long

'Contrôle date d'entrée

'If Me.TextBox1.Value <> "" Then
'Date_entree = Format(Me.TextBox1.Value, "dd/mm/yyyy")
'End If

'If Me.TextBox6.Value <> "" Then
'Date_sortie = Format(Me.TextBox6.Value, "dd/mm/yyyy")
'End If
If Me.TextBox1.Value <> "" Then
If Not IsDate(Me.TextBox1.Value) Then
MsgBox "La date d'entrée saisie n'est pas un date valide !"
Me.TextBox1.SetFocus
Exit Sub
Else
Date_entree = CDate(Me.TextBox1.Value)
End If
End If

'Contrôle date de sortie
If Me.TextBox6.Value <> "" Then
If Not IsDate(Me.TextBox6.Value) Then
MsgBox "La date de sortie saisie n'est pas un date valide !"
Me.TextBox6.SetFocus
Exit Sub
Else
Date_sortie = CDate(Me.TextBox6.Value)
End If
End If

'Inhibe l'affichage
Application.ScreenUpdating = False



'Ajouter un nouvel article
If MsgBox("Confirmer la saisie", vbYesNo, "confirmation") = vbYes Then
With ThisWorkbook.Sheets("SAISIE")
.Select
'Déprotection
Call ToutDeproteger
Derligne = .Range("F" & Rows.Count).End(xlUp).Row + 1

.Cells(Derligne, 4) = IIf(Date_entree = 0, "", Date_entree)
.Cells(Derligne, 5) = IIf(Date_sortie = 0, "", Date_sortie)
.Cells(Derligne, 6) = ComboBox1.Value
.Cells(Derligne, 7) = ComboBox2.Value
.Cells(Derligne, 8) = ComboBox3.Value
.Cells(Derligne, 9) = TextBox2.Value
.Cells(Derligne, 10) = TextBox3.Value
.Cells(Derligne, 11) = TextBox4.Value
.Cells(Derligne, 12) = TextBox5.Value
.Cells(Derligne, 16) = TextBox7.Value
End With
End If


'Error handling
On Error GoTo Defaut

Photo = ComboBox4.Value
Image1.Picture = LoadPicture("C:\JCR\Photos Bijoux\" & Photo & ".Jpg")
GoTo FinSub

Defaut:
'Image1.Picture = LoadPicture("C:\JCR\Photos Bijoux\Defaut.Jpg")
'Rafraichir le tableau croisé dynamique
Columns("D:D").NumberFormat = "m/d/yyyy"

Sheets("Stock Par Produit").Select
ActiveWorkbook.RefreshAll
Sheets("SAISIE").Select
Cells.Replace What:="#REF", Replacement:="SAISIE", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWorkbook.Save

Unload FormulaireSaisie
Call formuleColC
Call formuleColQ
Call formuleColR

Call ToutProteger
'FormulaireSaisie.Show


FinSub:
'Error handling
On Error GoTo 0

'Protection
Call ToutProteger

'Désinhibe l'affichage
Application.ScreenUpdating = True
End Sub

Merci de votre aide toujours aussi précieuse
Eric
 

job75

XLDnaute Barbatruc
Vous allez encore apprendre avec ce fichier (2).

En colonne C il peut y avoir des #N/A (sans SIERREUR) ou des textes vides "" (avec SIERREUR).

Donc utilisez plutôt :
VB:
Private Sub ComboBox4_Enter()
Dim tablo, i&, v, liste$(), n&
tablo = [BaseDeDonnees] 'matrice, plus rapide
For i = 1 To UBound(tablo)
    v = tablo(i, 1)
    If Not IsError(v) Then If v <> "" Then ReDim Preserve liste(n): liste(n) = v: n = n + 1
Next
ComboBox4 = ""
If n Then ComboBox4.List = liste Else ComboBox4.Clear
ComboBox4.DropDown 'déroule la liste
End Sub
De plus cette macro va mieux quand le tableau n'a qu'une ligne :
VB:
Sub AllerDerniereLigne()
Feuil1.Columns(3).Find("", , xlFormulas).Select '1ère cellule vide
End Sub
 

Pièces jointes

  • stock test(2).xlsm
    92.1 KB · Affichages: 1
Haut Bas