Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Problème Débogage VBA

eric72

XLDnaute Accro
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").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
 

eric72

XLDnaute Accro
j'avais juste nommé mon tableau BaseDeDonnées avec un accent, oups la boulette.
Tout est parfait!!!
Ouf !!!
Merci beaucoup pour le temps consacré, j'ai encore appris quelque chose grâce à vous.
Bonne journée
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: 7

Discussions similaires

Réponses
17
Affichages
348
Réponses
0
Affichages
154
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…