Titre du sujet : Re: Calcul de dates dans un USF
par myDearFriend! le 13/04/2012 19:02:55
Bonjour criscris11, le Forum,
Tu trouveras en pièce jointe une tentative de réponse à ta demande.
J'ai essayé de commenter le code VBA au mieux...
Pour info, j'ai d'abord dû apporter quelques légères modifications à ton Userform :
- En premier lieu, j'ai renommer tous les contrôles utiles pour qu'ils soient facilement repérable dans le code (c'est la première chose à faire si tu veux pouvoir analyser correctement un code VBA, le comprendre, voire le maintenir).
- Ensuite, j'ai supprimé les Frames que tu avais insérés et les ai remplacés par de simples labels transparents avec bordure en arrière plan : le visuel est quasi similaire. Pourquoi ? Parce que les Frames entrainent un bug VBA au niveau des évènements "Exit" des contrôles Textbox et j'en avais besoin ici
- Puis, j'ai aussi supprimé les Textbox que tu avais utilisés pour afficher la Durée et la date calculée DRDS pour les échanger là encore par des contrôles Label. J'applique un principe de base : les Textbox sont faits pour permettre à l'utilisateur de saisir quelque chose. En l'occurence, il s'agit là de 2 éléments exclusivement calculés et l'utilisateur n'a pas à intervenir sur ces champs. Des contrôles Labels semblent donc plus indiqués pour ce faire. On peut même leur donner le look de Textbox si on le souhaite, mais je pense qu'il est préférable d'orienter l'utilisateur et lui indiquer visuellement là, où il peut saisir et là, où il ne peut pas.
- Au final, j'ai attribué les propriétés suivantes aux 3 TextBox restantes (pour les Dates) :
- Maxlength = 8
- AutoTab = True
J'ai utilisé le code VBA suivant dans le module de code du Userform :
Option Explicit
'-----------------------------------------------------------------------
' Auteur : myDearFriend! - www.mdf-xlpages.com
' Date : 13/04/2012
'-----------------------------------------------------------------------
' ======================================================
' CONTROLE DE LA SAISIE UTILISATEUR
' ======================================================
Private Sub txtDu_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = KeyNumOnly(KeyAscii)
End Sub
Private Sub txtAu_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = KeyNumOnly(KeyAscii)
End Sub
Private Sub txtReeng_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = KeyNumOnly(KeyAscii)
End Sub
Private Function KeyNumOnly(ByVal K As Integer) As Integer
'Autorise uniquement les touches numériques de 0 à 9 (renvoyées par Keypress)
If K < 48 Or K > 57 Then K = 0
KeyNumOnly = K
End Function
' ======================================================
' FORMAT et CALCUL A LA SORTIE DE CHAQUE TEXTBOX
' ======================================================
Private Sub txtDu_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim T As String
T = FormatDate(txtDu.Text)
If T <> "" Then
txtDu.Text = T
CalculValid 'calcul et autorisation de validation
Else
Cancel = True 'le focus reste sur le textbox pour correction
End If
End Sub
Private Sub txtAu_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim T As String
T = FormatDate(txtAu.Text)
If T <> "" Then
txtAu.Text = T
CalculValid 'calcul et autorisation de validation
Else
Cancel = True 'le focus reste sur le textbox pour correction
End If
End Sub
Private Sub txtReeng_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim T As String
T = FormatDate(txtReeng.Text)
If T <> "" Then
txtReeng.Text = T
CalculValid 'calcul et autorisation de validation
Else
Cancel = True 'le focus reste sur le textbox pour correction
End If
End Sub
Private Function FormatDate(D As String) As String
'insèrer les /
If Len(D) = 8 Then
D = Left(D, 2) & "/" & Mid(D, 3, 2) & "/" & Mid(D, 5)
If IsDate(D) Then FormatDate = D
ElseIf Len(D) = 10 And IsDate(D) Then
FormatDate = D
End If
End Function
Private Sub CalculValid()
Dim D1 As Date, D2 As Date, D3 As Date, D_Drds As Date
Dim cptMtot As Integer, cptA As Integer, cptM As Integer, cptJ As Integer
'Les 3 dates sont-elles présentes et valables ?
On Error Resume Next
D1 = CDate(txtDu.Text)
D2 = CDate(txtAu.Text)
D3 = CDate(txtReeng.Text)
On Error GoTo 0
'Calcul durée
If D1 <> 0 And D2 <> 0 Then
cptMtot = DateDiff("m", D1, D2 + 1) 'Combien de mois entre les 2 dates ?
cptA = cptMtot \ 12 'déduction de l'écart en année
cptM = cptMtot - cptA * 12 'déduction de l'écart restant en mois
cptJ = D2 + 1 - DateAdd("m", cptMtot, D1) 'déduction de l'écart restant en jours
lblDuree.Caption = cptA & " An" & IIf(cptA > 1, "s, ", ", ") & cptM & " Mois et " & cptJ & " Jour" & IIf(cptJ > 1, "s", "")
' Calcul date réengagement
If D3 <> 0 Then
D_Drds = DateAdd("yyyy", -cptA, D3) '- années
D_Drds = DateAdd("m", -cptM, D_Drds) '- mois
D_Drds = DateAdd("y", -cptJ, D_Drds) '- jours
lblDRDS.Caption = D_Drds
End If
End If
' Rendre bouton Valider accessible ?
btnValider.Enabled = D1 <> 0 And D2 <> 0 And D3 <> 0
End Sub
' ======================================================
' BOUTONS DE COMMANDE
' ======================================================
Private Sub btnAnnuler_Click()
Unload Me
End Sub
Private Sub btnValider_Click()
'Mettre à jour la feuille de calcul
'DateValue() est indispensable pour de "vraies" dates dans les cellules
Range("F3").Value = DateValue(txtDu.Value)
Range("H3").Value = DateValue(txtAu.Value)
Range("E8").Value = DateValue(txtReeng.Value)
Range("F5").Value = lblDuree.Caption
Range("H8").Value = DateValue(lblDRDS.Caption)
Unload Me
End Sub
J'ai essayé de répondre au plus près de ta demande et des contraintes exposées : la saisie est limitées et la cohérence des dates est vérifiée (format). Je n'ai toutefois pas fait de contrôle pour m'assurer que la date "DU" est bien inférieure à la date "AU".
Cela dit, si tu préfères éviter toute cette usine pour permettre une saisie "simplifiée" et en vérifier la cohérence (format des dates, dates reconnues ou non, etc...), je ne puis que t'inviter à voir du côté du mDF XLcalendar (1) qui joue très bien son rôle pour les TextBox de Userform, permettant d'une part, une saisie conviviale pour l'utilisateur et d'autre part, un code VBA nettement plus light (il n'y a plus lieu de vérifier le format des dates insérées). Cela nécessite toutefois que ce complément mDF XLcalendar soit effectivement installé sur chaque machine devant faire tourner ton classeur...
(voir cette FAQ. Pour info, un tutoriel complet est en cours d'écriture pour faire suite à la nouvelle version de cet utilitaire).
En espérant t'avoir aidé.
Cordialement,
(1) Oui, un peu de Pub  ! Faut bien que quelqu'un la fasse, hein !?
|
Didier FOURGEOT