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
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