Microsoft 365 erreur d'éxecution -2147417848 (80010108)

[eric72]

Bonsoir,

J'utilise un userform pour entrer des données dans un tableau et, bizzarement à intervalle irrégulier (1 fois sur 3 ou 4 entrées) j'ai ce bug qui apparait
et du coup ca ne prend pas en compte mon ajout de données, a ce moment il note juste ma date-entree et il plante sur cette ligne.
Quelqu'un a t il déjà rencontré ce problème ?
Merci beaucoup pour votre aide
Eric

Private Sub CommandButton1_Click()
Dim date_entree As Date
If Me.TextBox1.Value <> "" Then
date_entree = Format(Me.TextBox1.Value, "dd/mm/yyyy")
End If
Dim date_sortie As Date
If Me.TextBox6.Value <> "" Then
date_sortie = Format(Me.TextBox6.Value, "dd/mm/yyyy")
End If
Dim derligne As Integer
'Ne pas voir la macro s'exécuter
Application.ScreenUpdating = False
Call ToutDeproteger
'Ajouter un nouvel article
Sheets("Saisie").Select
If MsgBox("Confirmer la saisie", vbYesNo, "confirmation") = vbYes Then

derligne = Sheets("saisie").Range("f1048576").End(xlUp).Row + 1

Cells(derligne, 4) = date_entree 'VOILA LA CAUSE DU BUG
Cells(derligne, 5) = 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 If
On Error GoTo Defaut

Photo = ComboBox4.Value
Image1.Picture = LoadPicture("C:\JCR\Photos Bijoux\" & Photo & ".Jpg")
Exit Sub
Defaut:
'Image1.Picture = LoadPicture("C:\JCR\Photos Bijoux\Defaut.Jpg")
'Rafraichir le tableau croisé dynamique
Columns("D").Select

Selection.NumberFormat = "m/d/yyyy"
Sheets("Stock Par Produit").Select
ActiveWorkbook.RefreshAll
Sheets("SAISIE").Select

Call ToutProteger
Unload FormulaireSaisie
'FormulaireSaisie.Show
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

 

[James007]

Bonsoir,

A tout hasard ... si tu supprimes As Date dans le Dim date_entree et aussi dans le Dim date_sortie

cela pourrait t'éviter le conflit entre le Texte et la Date ... A tester

 

[Dudu2]

Bonsoir,
En effet, je ne comprends pas pourquoi tu mets du texte dans une variable Date:
date_entree = Format(Me.TextBox1.Value, "dd/mm/yyyy")
Même si VBA fera sans doute une conversion implicite. C'est peut-être ça qui finit par exploser plus loin !

Il faudrait faire:
If IsDate(Me.TextBox1.Value) Then date_entree = CDate(Me.TextBox1.Value) Else date_entree = 0

 

[eric72]

Re bonsoir,
je teste cela demain et je vous redis, merci pour votre dévouement
Eric

 

[eric72]

Bonjour,
Je suis désolé mais je ne suis pas assez calé en VBA pour adapter votre code, est ce trop demander de modifier le code plus haut pou me faciliter la tâche.
Merci beaucoup
Eric

 

[Dudu2]

Bonjour,
Ça dépend de ce que tu veux faire.
Est-ce qu'il est essentiel ou pas que les valeurs saisies en date d'entrée et de sortie soient des dates ? Ou acceptes-tu que ce soit aussi des valeurs quelconques ?

 

[eric72]

Re bonjour,
ca sera toujours des dates
merci

 

[Dudu2]

Ok, je suppose que tu veux dire qu'il faut que ce soit des dates (car il est impossible d'avoir la certitude que l'utilisateur entrera une date valide, une erreur de frappe étant toujours possible).
J'ai pas trop compris ta séquence d'erreur, mais il y a des actions qu'il faut faire qu'on soit passer dans la séquence d'erreur ou pas.
Donc le code ci-dessous à adapter si besoin.

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
        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
   
    'Déprotection
    Call ToutDeproteger
   
    'Ajouter un nouvel article
    If MsgBox("Confirmer la saisie", vbYesNo, "confirmation") = vbYes Then
        With ThisWorkbook.Sheets("Saisie")
            .Select
            Derligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
           
            .Cells(Derligne, 4) = IIf(Date_entree = 0, "", Format(Date_entree, "dd/mm/yyyy"))
            .Cells(Derligne, 5) = IIf(Date_sortie = 0, "", Format(Date_sortie, "dd/mm/yyyy"))
            .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
   
    Unload FormulaireSaisie
   
    'FormulaireSaisie.Show
    ActiveWorkbook.Save

FinSub:
    'Error handling
    On Error GoTo 0
   
    'Protection
    Call ToutProteger
   
    'Désinhibe l'affichage
    Application.ScreenUpdating = True
End Sub

 

[eric72]

Re,
Je viens de tester ce code et ca a fonctionné 10 fois sans bug, c'est génial
Merci pour ta réactivité, vous êtes géniaux
Bonne journée
Eric

 

[eric72]

Re,
Je me suis enflammé trop vite, new bug ici :
.Cells(Derligne, 4) = IIf(Date_entree = 0, "", Format(Date_entree, "dd/mm/yyyy"))
aie!!!

 

[Dudu2]

Derligne vaut combien ?
Est-ce que la feuille est protégée au moment de l'affectation ? Tu as vérifié ?

 

[eric72]

Le mieux est peut être de ta fournir le fichier ca sera plus simple(userform dans feuil "saisie")
Merci encore
Eric

 

[eric72]

Depuis la modification de code quand je tape 08/11/2019 il inscrit 11/08/2019
c'est peut être pour ca que le code précédent était là
j'y perds mon latin
Merci
Eric

 

[Dudu2]

Les dates en Excel c'est délicat. Entre le format local et le format américain. Je vais vérifier ce que je t'ai indiqué.

 

[Dudu2]

Au temps pour moi !
Si les cellules destinataires sont en format date, il ne faut évidemment pas envoyer le texte issu de Format() mais directement la variable date.

.Cells(Derligne, 4) = IIf(Date_entree = 0, "", Date_entree)
.Cells(Derligne, 5) = IIf(Date_sortie = 0, "", Date_sortie)

Sinon, tu as toujours le problème de plantage ?