Code VBA pour un problème de date
Bonsoir,
Il faudrait qu'à certaines conditions, des dates inscrites dans un fomat MM.AAAA soient transformées automatiquement au format JJ.MM.AAAA à l'aide d'un code VBA.
Pouvez-vous m'aider ? Tout est indiqué dans le fichier ci-joint.
Bonne soirée.
Bonjour,
Essaie avec ce code :
Sub test()
'Macro Dan pour yvouille le 04/12/2009
Range("B2") = Format(Range("B3"), "dd/mm/yyyy")
Range("C2") = Range("C3") + Day(DateSerial(Year(Range("C3")), Month(Range("C3")) + 1, 0)) - 1
End SubOn pourrait aussi faire cela en ne partant qu'avec une seule date. Donc mettre la date uniquement dans B3.
Pour le calcul des mois en D2, tu peux aussi essayer cette formule --> =DATEDIF(B2;C2;"m")
Amicalement
Dan
Salut Dan,
Merci beaucoup pour ta réponse et excuse mon temps de réaction ; j'étais absent quelques jours.
J'ai essayé ton code selon le document ci-joint, mais ça ne fonctionne pas comme désiré. Si j'inscris par exemple 02.2009 et B3, il n'est pas inscrit automatiquement le 01.02.2009 (début du mois) en B2. De même, si j'inscris par exemple également 02.2009 en C3, il n'est pas inscrit automatiquement le 28.02.2009 (fin du mois) en C2. Peux-tu m'indiquer si je n'utilise pas correctement ton code ?
Je ne peux pas non plus utiliser ta proposition de remplacer ma formule en D2 car celle ci-renvoi 0 mois si j'indique par exemple du 1er mai 2009 ou 31 mai 2009 alors que je voudrais que ça renvoie 1 mois. Mais là n'était pas mon problème non plus
NB : J'avais fait des erreurs dans les références de cellules dans mon premiers fichier joint à mon premier message, mais il semble que tu l'avais remarqué vu les références utilisées pour ton code.
re,
La macro évidemment ne se déclenche pas automatiquement. Donc là il fallait la placer dans un module et faire le test pour voir si cela correspondait à ce que tu veux.
Essaie avec ce code :
Dim ok As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
'MAcro Dan pour Yvouille le 10/12/2009 - XL pratique
If ok = True Then Exit Sub
If Not Intersect(Target, Range("B3", "C3")) Is Nothing Then
ok = True
Range("B2") = Format(Range("B3"), "mm/dd/yyyy")
Range("C2") = Range("C3") + Day(DateSerial(Year(Range("C3")), Month(Range("C3")) + 1, 0)) - 1
End If
ok = False
End SubCode à placer dans la feuille concernée. (clique droite sur l'onglet puis "visualiser le code" et placer la macro en question)
A noter qu'il faut que j'ai considéré qu'il faut mettre une date dans les deux cellules, à savoir B3 et C3 sans quoi B2 et C2 ne seront pas corrects.
A te relire
Dan
Salut Dan,
Merci infiniment pour ton aide.
Avec le code :
Range("B2") = Format(Range("B3"), "mm/dd/yyyy")ça renvoyait d'une manière erronée le jour du mois de janvier correspondant au mois désiré en B2. Par exemple si j'indiquais 12.2005 pour décembre 2005, c'est le 12.01.2005 qui était reporté au lieu du 01.12.2005. J'ai donc modifié cette partie sur la base de ton autre code et ça fonctionne à merveille.
Voici donc ce nouveau code complet :
Private Sub Worksheet_Change(ByVal Target As Range)
'MAcro Dan pour Yvouille le 10/12/2009 - XL pratique
If ok = True Then Exit Sub
If Not Intersect(Target, Range("B3", "C3")) Is Nothing Then
ok = True
Range("B2") = Range("B3") + Day(DateSerial(Year(Range("B3")), Month(Range("B3")), 1)) - 1
Range("C2") = Range("C3") + Day(DateSerial(Year(Range("C3")), Month(Range("C3")) + 1, 0)) - 1
End If
ok = False
End Sub J'aurais encore une dernière demande à te présenter : Ne serait-il pas possible en plus que, si l'on modifie par la suite B2 ou C2, les valeurs présentes en B3 ou C3 soient effacées individuellement ???
A te relire.
Re,
essaie ce code
Dim ok As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
'MAcro Dan pour Yvouille le 10/12/2009 - XL pratique
If ok = True Then Exit Sub
If Not Intersect(Target, Range("B3", "C3")) Is Nothing Then
ok = True
Range("B2") = Range("B3") + Day(DateSerial(Year(Range("B3")), Month(Range("B3")), 1)) - 1
Range("C2") = Range("C3") + Day(DateSerial(Year(Range("C3")), Month(Range("C3")) + 1, 0)) - 1
End If
If Not Intersect(Target, Range("B2", "C2")) Is Nothing Then
ok = True
Target.Offset(1, 0).ClearContents
End If
ok = False
End SubBonne journée
Dan
Salut Dan,
Ton nouveau code me permet de réaliser tout mes souhaits. Je te suis très reconnaissant pour ton aide.
Bonnes salutations et à la prochaine.