Microsoft 365 La fonction date/year

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Bonjour,

Je n'arrive pas à transcrire la fonction Excel : DATE(ANNEE('1 - Feuille'!F6);7;1) en VBA.
En faite, je souhaite récupérer la date comme [G6].Value=date(year([F6]),7,1) mais cela ne marche pas.

Merci pour votre aide.
 
Solution
Code:
Sub Date_de_bas()
With Sheets("1 - Feuille").[F5]
    If Not IsDate(CStr(.Value)) Then mois = "" Else mois = Month(.Value)
 End With
 Select Case mois
    Case 1, 2, 3: [F9].Value = DateSerial(Year:=Year([F5]), Month:=7, Day:=1)
    Case 4, 5, 6: [F9].Value = DateSerial(Year:=Year([F5]), Month:=10, Day:=1)
    Case 7, 8, 9: [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=1, Day:=1)
    Case 10, 11, 12: [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=4, Day:=1)
    Case Else: [F9].Value = ""
 End Select
End Sub

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Bonjour Marieparis, le forum

avec une date en F6

Cordialement, @+
VB:
[G6].Value = DateSerial(Year:=Year([F6]), Month:=7, Day:=1)
Merci Yeahou,

Voici mon code :
VB:
Sub Date_de_bas()
 Dim rSrc As Range
 Set rSrc = Sheets("1 - Feuille").[F5]
 mois = Month(rSrc)
 Select Case mois
 Case 1, 2, 3
 [F9].Value = DateSerial(Year:=Year([F5]), Month:=7, Day:=1)
 Case 4, 5, 6
 [F9].Value = DateSerial(Year:=Year([F5]), Month:=10, Day:=1)
 Case 7, 8, 9
 [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=1, Day:=1)
 Case 10, 11, 12
 [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=4, Day:=1)
 Case Else
 [F9].Value = ""
 End Select
End Sub

Il marche bien, mais quand je supprime la date en F5, je reçois l'erreur :
1635258150660.png


Est-ce que vous connaissez comment gérer ce genre d'erreur dans le code ?

Merci beaucoup pour votre aide !
 

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Bonsoir,
Comment récupérer le mois de [F5] si sa valeur est null?
Code:
Set rSrc = Sheets("1 - Feuille").[F5]
 mois = Month(rSrc)

Fait un test de la valeur de [F5] avant de continuer !
Merci beaucoup,

J'ai amélioré le code :
VB:
Sub Date_de_bas()
 Dim rSrc As Range
 Set rSrc = Sheets("1 - Feuille").[F5]
 mois = Month(rSrc)
 If Not IsNull(mois) Then
 Select Case mois
 Case 1, 2, 3
 [F9].Value = DateSerial(Year:=Year([F5]), Month:=7, Day:=1)
 Case 4, 5, 6
 [F9].Value = DateSerial(Year:=Year([F5]), Month:=10, Day:=1)
 Case 7, 8, 9
 [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=1, Day:=1)
 Case 10, 11, 12
 [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=4, Day:=1)
 Case Else
 [F9].Value = ""
 End Select
 Else
 [F9].Value = ""
 End If
End Sub

Mais quand je supprime la date en F5, je reçois la même erreur :
1635260601172.png


Voici le code pour déclencher la procédure (sur la feuille 1) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 
    
    If Not Intersect(Target, Range("F5")) Is Nothing Then
        Call Date_de_bas
    End If
    
End Sub

Merci pour votre aide !
 

Pièces jointes

  • 1635260563044.png
    1635260563044.png
    8.1 KB · Affichages: 11

dysorthographie

XLDnaute Accro
Code:
Sub Date_de_bas()
With Sheets("1 - Feuille").[F5]
    If Not IsDate(CStr(.Value)) Then mois = "" Else mois = Month(.Value)
 End With
 Select Case mois
    Case 1, 2, 3: [F9].Value = DateSerial(Year:=Year([F5]), Month:=7, Day:=1)
    Case 4, 5, 6: [F9].Value = DateSerial(Year:=Year([F5]), Month:=10, Day:=1)
    Case 7, 8, 9: [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=1, Day:=1)
    Case 10, 11, 12: [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=4, Day:=1)
    Case Else: [F9].Value = ""
 End Select
End Sub
 

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Code:
Sub Date_de_bas()
With Sheets("1 - Feuille").[F5]
    If Not IsDate(CStr(.Value)) Then mois = "" Else mois = Month(.Value)
 End With
 Select Case mois
    Case 1, 2, 3: [F9].Value = DateSerial(Year:=Year([F5]), Month:=7, Day:=1)
    Case 4, 5, 6: [F9].Value = DateSerial(Year:=Year([F5]), Month:=10, Day:=1)
    Case 7, 8, 9: [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=1, Day:=1)
    Case 10, 11, 12: [F9].Value = DateSerial(Year:=Year([F5] + 1), Month:=4, Day:=1)
    Case Else: [F9].Value = ""
 End Select
End Sub
Merci, ça marche !
J'ai une anomalie sur la ligne Year([F5] + 1) : pour incrémenter l'année de 1, faudrait-il d'ajouter la fonction sum ?
 

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Avec la solution précédente on aura compris que le VBA n'est pas nécessaire.

Il suffit d'entrer la formule en F9 manuellement une fois pour toute.
Justement, j'avais une formule, j'ai implémenté du code VBA, car la formule est visible dans la cellule. En plus, à la fermeture, mon programme doit effacer les données, il vaut mieux coder en VBA. Merci !