XL 2016 Format de date sous vba

vanin

XLDnaute Occasionnel
Bonjour, j'ai encore besoin de votre précieuse aide.
A partir d'un formulaire excel vba je remplis une facture (feuille Devis).
le formulaire puise les infomations de la feuille produits
chaque ligne de la facture contient la date de péremption du produit en colonne K
le souci c'est que certaines dates de péremption posent problèmes.
les dates de péremption respectives des produit tika_annanas 250ml et tika_mangue 250ml sur la feuille produit sont 10/05/2021 mais sur le devis au lieu du 10/05/2021 c'est plutot 05/10/2021 qui s'affiche. alors que une date comme 14/05/2021 ne change pas.
ci dessous le code du bouton valider du formulaire qui permet d'ajouter les informations sur la facture.
le code .Cells(20 + L, 11).Value = lstDevis.List(L, 5) permet d'ajouter la date de péremption du formulaire à la facture (feuille devis) en colonne K à partir de la ligne 20.
comment réécrire ce code afin que les dates s'affichent correctement? comment formater les données de la colonne K afin que les dates s'affichent jj/mm/aaaa
merci



Private Sub btnValider_Click()
Dim L As Long
Dim Cumul As Currency


'Numéro du Devis
With Sheets("N°de Devis")
L = .Cells(.Rows.Count, 2).End(xlUp).Row
.Cells(L + 1, 2).Value = Date
.Cells(L + 1, 3).Value = Date
.Cells(L + 1, 4).Value = Val(.Cells(L, 4).Value) + 1
End With
With Sheets("Devis")
'Client
.Range("G2").Value = lblSociete.Caption
.Range("G3").Value = lblRue.Caption
.Range("G4").Value = lblQuartier.Caption
.Range("G5").Value = lblCommune.Caption
.Range("G6").Value = lblVille.Caption
.Range("G7").Value = Lblcanal.Caption
.Range("H41").Value = ComboBox_paiement.Value

.Range("D41").Value = DateValue(format(TextBoxpaiement.Value, "dd/mm/yyyy"))

.Range("H43").Value = (TextBoxecheance.Value)
If IsDate(TextBoxecheance.Value) Then .Range("H43").Value = CDate(TextBoxecheance.Value)
If IsDate(TextBoxpaiement.Value) Then .Range("D41").Value = CDate(TextBoxpaiement.Value)





'MAJ Devis
.Range("C13").Value = Mid(lblDevis.Caption, 11)
.Range("B17").Value = lblComm.Caption
'Effacer les anciennes données
.Range("B19:K35").ClearContents
'Mettre à jour le Devis
For L = 0 To lstDevis.ListCount - 1
If lstDevis.List(L, 1) <> ">>>" Then
.Cells(20 + L, 2).Value = lstDevis.List(L, 1)
.Cells(20 + L, 6).Value = lstDevis.List(L, 2)
.Cells(20 + L, 7).Value = Val(lstDevis.List(L, 4))
.Cells(20 + L, 8).Value = CCur(lstDevis.List(L, 3))
.Cells(20 + L, 9).Value = .Cells(20 + L, 7).Value * .Cells(20 + L, 8).Value

.Cells(20 + L, 11).Value = lstDevis.List(L, 5)



Cumul = Cumul + .Cells(20 + L, 9).Value


End If



Next L
If Val(txtRemise.Text) > 0 Then
.Cells(22 + L, 4).Value = "REMISE DE " & Val(txtRemise.Text) & " % >>>"
.Cells(22 + L, 9).Value = CCur(Cumul * Val(txtRemise.Text) / 100) * -1
End If
End With
HistoDevis
Unload Me


If Not IsDate(TextBoxpaiement.Value) Then
MsgBox "Format incorrect"
TextBoxpaiement = ""
Exit Sub

End If






Dim reponse As Byte
Dim ligne As Integer: ligne = 2
Dim lignef As Integer: lignef = 20

reponse = MsgBox("Souhaitez-vous valider la facture et mettre à jour les stocks", vbYesNo + vbQuestion)



If (reponse = 6) Then
While (ThisWorkbook.Worksheets("devis").Cells(lignef, 2).Value <> "")
ligne = 2
While (ThisWorkbook.Worksheets("produits").Cells(ligne, 2).Value <> "")

If (ThisWorkbook.Worksheets("devis").Cells(lignef, 2) = ThisWorkbook.Worksheets("produits").Cells(ligne, 2).Value) Then
ThisWorkbook.Worksheets("produits").Cells(ligne, 5).Value = ThisWorkbook.Worksheets("produits").Cells(ligne, 5).Value - ThisWorkbook.Worksheets("devis").Cells(lignef, 7)
ThisWorkbook.Worksheets("produits").Cells(ligne, 11).Value = ThisWorkbook.Worksheets("produits").Cells(ligne, 11).Value + ThisWorkbook.Worksheets("devis").Cells(lignef, 7)
End If
ligne = ligne + 1
Wend
lignef = lignef + 1
Wend

End If



MsgBox "Commande validée et archivée."




End Sub
 

Pièces jointes

  • feuille Devis.jpg
    feuille Devis.jpg
    253.8 KB · Affichages: 43

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 938
Membres
101 844
dernier inscrit
pktla