XL 2016 Format de date sous vba

  • Initiateur de la discussion Initiateur de la discussion vanin
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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: 48
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
76
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
247
Réponses
4
Affichages
360
Réponses
4
Affichages
427
Réponses
2
Affichages
403
Retour