Gérer les messages "Debug.Print" d'une fonction depuis une Sub
Bonjour,
J'ai des messages "Debug.Print" géré dans la fonction (CheckDate).
J'aimerais les gérer depuis la Sub (TestDate).
Comment pourrais-je procéder?
Option Explicit
Sub TestDate()
Dim MyDate As String
MyDate = "950229"
If CheckDate(MyDate) Then
Debug.Print MyDate & " => " & CheckDate(MyDate) ' 960229 => 29/02/1996
Else
Debug.Print MyDate & " => message" ' Selon le cas, le message de la Function CheckDate
End If
End Sub
Function CheckDate(strDate As String) As Date
Dim dtDate As Date
Dim YY As Integer, mm As Integer, dd As Integer
YY = CInt(Left(strDate, 2))
mm = CInt(Mid(strDate, 3, 2))
dd = CInt(Right(strDate, 2))
YY = SetYear(YY, Year(Now))
' YY = SetYear(YY, 2023)
' YY = SetYear(YY, 2049)
' YY = SetYear(YY, 2050)
' YY = SetYear(YY, 2051)
' YY = SetYear(YY, 2075)
' YY = SetYear(YY, 2099)
' Debug.Print YY
If dd = 0 And (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) Then
dd = 31
Debug.Print "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 31 sera utilisé par défaut."
ElseIf dd = 0 And (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) Then
dd = 30
Debug.Print "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 30 sera utilisé par défaut."
ElseIf dd = 0 And mm = 2 Then
If Not EstBissextile(YY) Then
dd = 28
Debug.Print "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 28 sera utilisé par défaut."
Else
dd = 29
Debug.Print "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 29 sera utilisé par défaut."
End If
End If
If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) And dd > 31 Then
Debug.Print "Ce moi, ne peut avoir que 31 jours!"
End If
If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30 Then
Debug.Print "Ce moi, ne peut avoir que 30 jours!"
Exit Function
End If
If EstBissextile(YY) Then
If mm = 2 And dd > 29 Then
Debug.Print "Année bissextile, février ne peut pas avoir plus de 29 jours!"
Exit Function
End If
Else
If mm = 2 And dd > 28 Then
Debug.Print "Année non bissextile, février ne peut pas avoir plus de 28 jours!"
Exit Function
End If
End If
dtDate = DateSerial(YY, mm, dd)
'Debug.Print strDate & " = " & dtDate
CheckDate = dtDate
End Function
Function SetYear(YY As Integer, pivot As Integer) As Integer
Dim current_year, siecle, temp, ecart As Integer
current_year = pivot Mod 100
siecle = pivot - current_year
temp = siecle + YY
ecart = temp - pivot
Do While ecart > 50
temp = temp - 100
ecart = temp - pivot
Loop
Do While ecart < -49
temp = temp + 100
ecart = temp - pivot
Loop
SetYear = temp
End Function
Function EstBissextile(Annee As Integer) As Boolean
'une année bissextile est divisible par 4
If Annee Mod 4 <> 0 Then
EstBissextile = False
Exit Function
End If
'une année bissextile est divisible par 400 et par 100 en même temps, mais pas par 100 seul
If Annee Mod 100 = 0 And Annee Mod 400 <> 0 Then
EstBissextile = False
Exit Function
End If
EstBissextile = True
End FunctionBonjour,
Perso, je procède de cette manière :
Public Messages As String ' ou Dim si votre code reste dans le module
Sub TestDate()
Dim MyDate As String
Messages = "Liste des messages : " & Chr(10)
MyDate = "950229"
If CheckDate(MyDate) Then
Debug.Print MyDate & " => " & CheckDate(MyDate) ' 960229 => 29/02/1996
Else
If Messages <> "Liste des messages : " & Chr(10) Then
Debug.Print Messages ' Selon le cas, le message de la Function CheckDate
' MsgBox Messages, vbCritical
End If
End SubDans votre fonction, vous remplacez les Debug.Print par :
Messages = Messages & "Jour n'est pas spécifié dans cette date!" & vbCrLfBonjour,
Merci pour votre exemple!
Je ne comprenais pas pourquoi mes tentatives étaient infructueuses.
J'exploite effectivement la fonction CheckDate en dehors du module et j'utilisais une déclaration locale!
J'avais hormis la déclaration Public, malgré le message d'erreur de compilation: Variable non définie.
Re-bonjour,
Les messages relatifs au jour = 0 ne sont pas gérés.
If dd = 0 And (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) Then
dd = 31
Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 31 sera utilisé par défaut."
ElseIf dd = 0 And (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) Then
dd = 30
Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 30 sera utilisé par défaut."
ElseIf dd = 0 And mm = 2 Then
If Not EstBissextile(YY) Then
dd = 28
Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 28 sera utilisé par défaut."
Else
dd = 29
Messages = "Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 29 sera utilisé par défaut."
End If
End IfComment puis-je les afficher?
Ma sub:
Sub TestDate()
Dim MyDate As String
MyDate = "950431"
If CheckDate(MyDate) Then
Debug.Print MyDate & " => " & CheckDate(MyDate) ' 960229 => 29/02/1996
Else
Debug.Print MyDate & " => " & Messages
End If
End SubCe cas a-t-il un sens ?
Ces dates sont extraites de codes-barres et dans certain cas le jour n'est pas spécifié!
Dans ce cas le dernier jour du moi est appliqué!
231200 devient 231231 soit 31/12/2023.
Dans ces codes-barres le format et YYMMDD.
La réponse est implicitement le message. Au lieu de faire un debug.print, vous assignez une valeur "X" par exemple, dans une cellule en cas de message.
J'aimerais autant que possible éviter le recours à une cellule, j'imaginais plutôt une nouvelle condition ou test, mais je ne trouve pas où le faire!
Désolé, je ne comprends pas ce que vous voulez obtenir, puisqu'un message est implicitement la réponse.
Je ne peux vous aider plus, bon courage.
Dans le cas ou DD = 0 en plus de la conversion en dernier jour du moi, j'aimerais avoir le message.
Comme vous l'avez fait remarquer, le message et implicitement la réponse.
J'essaie de sortir ce message de la réponse pour l'appeler en plus, mais, je ne dois pas agir ou il faut!
Exemple du résultat espéré:
Jour n'est pas spécifié dans cette date!
Jour 30 sera utilisé par défaut.
230400 => 30/04/2023
Bonjour le fil,
@Léo39, il est vrai que votre problème n'est pas très clair,
Voici ce que j'ai compris, j'ai changé quelque peu la fonction CheckDate
Option Explicit
Dim Msg As String
Sub TestDate()
Dim MyDate As String
MyDate = "950431"
Debug.Print MyDate & " => " & CheckDate(MyDate) ' 960229 => 29/02/1996
End Sub
Function CheckDate(strDate As String) As String
Dim dtDate As Date
Dim YY As Integer, mm As Integer, dd As Integer
YY = CInt(Left(strDate, 2))
mm = CInt(Mid(strDate, 3, 2))
dd = CInt(Right(strDate, 2))
Msg = ""
YY = SetYear(YY, Year(Now))
' YY = SetYear(YY, 2023)
' YY = SetYear(YY, 2049)
' YY = SetYear(YY, 2050)
' YY = SetYear(YY, 2051)
' YY = SetYear(YY, 2075)
' YY = SetYear(YY, 2099)
' Debug.Print YY
If dd = 0 And InStr(1, "1,3,5,7,8,10,12", mm) > 0 Then
dd = 31
Msg = strDate & " Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 31 sera utilisé par défaut."
ElseIf dd = 0 And InStr(1, "4,6,9,11", mm) > 0 Then
dd = 30
Msg = strDate & " Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 30 sera utilisé par défaut."
ElseIf dd = 0 And mm = 2 Then
If Not EstBissextile(YY) Then
dd = 28
Msg = strDate & " Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 28 sera utilisé par défaut."
Else
dd = 29
Msg = strDate & " Jour n'est pas spécifié dans cette date!" & vbCrLf & "Jour 29 sera utilisé par défaut."
End If
End If
If InStr(1, "1,3,5,7,8,10,12", mm) > 0 And dd > 31 Then
Msg = strDate & " Ce mois, ne peut avoir que 31 jours!"
End If
If InStr(1, "4,6,9,11", mm) > 0 And dd > 30 Then
Msg = strDate & " Ce mois, ne peut avoir que 30 jours!"
'Exit Function = Ne pas mettre
End If
If EstBissextile(YY) Then
If mm = 2 And dd > 29 Then
Msg = strDate & " Année bissextile, février ne peut pas avoir plus de 29 jours!"
'Exit Function = Ne pas mettre
End If
Else
If mm = 2 And dd > 28 Then
Msg = strDate & " Année non bissextile, février ne peut pas avoir plus de 28 jours!"
'Exit Function = Ne pas mettre
End If
End If
dtDate = DateSerial(YY, mm, dd)
If Msg = "" Then
CheckDate = dtDate
Else
CheckDate = dtDate & "/" & Msg
End If
End Function
Function SetYear(YY As Integer, pivot As Integer) As Integer
Dim current_year, siecle, temp, ecart As Integer
current_year = pivot Mod 100
siecle = pivot - current_year
temp = siecle + YY
ecart = temp - pivot
Do While ecart > 50
temp = temp - 100
ecart = temp - pivot
Loop
Do While ecart < -49
temp = temp + 100
ecart = temp - pivot
Loop
SetYear = temp
End Function
Function EstBissextile(Annee As Integer) As Boolean
'une année bissextile est divisible par 4
If Annee Mod 4 <> 0 Then
EstBissextile = False
Exit Function
End If
'une année bissextile est divisible par 400 et par 100 en même temps, mais pas par 100 seul
If Annee Mod 100 = 0 And Annee Mod 400 <> 0 Then
EstBissextile = False
Exit Function
End If
EstBissextile = True
End FunctionA+
Bonjour,
@BrunoM45 Merci d'intervenir pour tenter de m'aider.
Dans l'état actuel en copiant le code que vous avez modifié dans un module
Pour (MyDate = "950431") l'exécution j'obtiens :
950431 =>
-------------
Et pour un jour a 0
(MyDate = "950400") l'exécution j'obtiens :
950400 => 30/04/1995/950400 Jour n'est pas spécifié dans cette date!
Jour 30 sera utilisé par défaut.
Je regarderai de plus près dès que possible.
Si de votre côté vous voyez ou est le problème ?
Salut à tous,
Oui compliqué tout cela.
En général il faut penser Excel avant de penser VBA, excel comporte une fonction qui renvoie le dernier jour du mois sans faire tout un tas de conditions qui ne font qu'alourdir le code.
La fonction LastDayOfMonth récupère le dernier jour du mois
La fonction Checkdate va mettre en forme la date de sortie selon le cas jour omis ou non.
Jai ajouté le Debug.Print, mais il faut savoir que cela ne sert qu'en programmation, en utilisation normale l'environnement VBE ne doit pas être ouvert sauf s'il y a un problème, et encore, si une bonne programmation est faite on ne doit pas le voir.
Voici les deux fonctions qui ont peut-être besoin d'être affinées.
Public Function LastDayOfMonth(ByVal Value As Variant, Optional ByVal justDay As Boolean = True) As Variant
Dim lastDay As Variant
If IsDate(Value) Then
If justDay Then
lastDay = Day(Application.WorksheetFunction.EoMonth(DateSerial(Year(Value), Month(Value), Day(Value)), 0))
Else
lastDay = CDate(Application.WorksheetFunction.EoMonth(DateSerial(Year(Value), Month(Value), Day(Value)), 0))
End If
LastDayOfMonth = lastDay
End If
End Function
Public Function CheckDate(ByVal Value As Variant) As Date
Dim localYear As Integer
localYear = CInt(Left$(Value, 2))
Dim LocalMonth As Integer
LocalMonth = CInt(Mid$(Value, 3, 2))
Dim localDay As Integer
localDay = CInt(Right$(Value, 2))
Dim localDate As Date
If localDay = 0 Then
localDay = LastDayOfMonth(localYear & "/" & LocalMonth & "/" & "01")
Debug.Print "Le mois n'est pas renseigné le dernier jour : "; localDay; " est défini par défaut."
End If
localDate = DateSerial(localYear, LocalMonth, localDay)
CheckDate = localDate
End FunctionEt pour finir Excel gère très bien les années bissextiles.
Deux exemples avec les jours à 0 et à 12
Bonsoir,
Bonjour,
@BrunoM45 Merci d'intervenir pour tenter de m'aider.
Dans l'état actuel en copiant le code que vous avez modifié dans un module
Pour (MyDate = "950431") l'exécution j'obtiens :
950431 =>
-------------
Et pour un jour a 0
(MyDate = "950400") l'exécution j'obtiens :
950400 => 30/04/1995/950400 Jour n'est pas spécifié dans cette date!
Jour 30 sera utilisé par défaut.
Je regarderai de plus près dès que possible.
Si de votre côté vous voyez ou est le problème ?
C'est vos "Exit Function" qui mettent le bazard, désolé il faut les supprimer
A+
Merci à vous tous, j'étudie toutes les possibilités!
@jean-Paul, merci pour votre intervention.
Vos fonctions sont certainement plus adaptées à la gestion du dernier jour du mois, mais me perturbe beaucoup!
J'éprouve beaucoup de difficultés à adapter l'existant, notamment ma fonction SetYear.
Concernant les années bissextiles vu que la "date" de départ est un string, je ne me projet pas !
@BrunoM45
L'inconvénient de votre méthode est CheckDate = dtDate & "/" & Msg
Qui donne :
950400 => 30/04/1995/950400
/950400 après 30/04/1995 est de trop!
Re,
Il faut savoir ce que vous voulez, non
Vous voulez le message d'erreur ou pas !?
Après, il suffit de séparer la 2ème partie de la date finale
Bonjour,
@BrunoM45, en séparent la 2ème partie de la date finale c'est OK!
J'ai une petit "Bug".
En testant le jour 0 pour janvier avec MyDate = "230100"
Le remplacement de 0 par le dernier jour du mois fonctionne, mais je n'ai pas le bon message.
Je devrais obtenir:
230100 => 31/01/2023 => 230100 Jour n'est pas spécifié dans cette date!
Jour 31 sera utilisé par défaut.
J'obtiens:
230100 => 31/01/2023 => 230100 Ce mois, ne peut avoir que 30 jours!
Cela se produit aussi chez vous?
Re,
Voilà j'ai un peu simplifier tout cela, et supprimer un bug apparemment.
Ne sachant pas comment est fait ton programme, on ne peut pas t'aider pour l'utilisation de la fonction.
Donc voici la fonction qui ne fait que te retourner une date complète formatée avec le dernier jour du mois, ou bien seulement le dernier jour du mois, selon le paramètre justDay, Excel se charge de la gestion des années bissextiles, comme tu peux le voir sur la photo.
Public Function CheckDate(ByVal Value As Variant, Optional ByVal justDay As Boolean = True) As Variant
Dim localYear As Integer
localYear = CInt(Left$(Value, 2))
Dim LocalMonth As Integer
LocalMonth = CInt(Mid$(Value, 3, 2))
Dim localDay As Integer
localDay = CInt(Right$(Value, 2))
Dim localDate As Variant
If localDay = 0 Then
localDate = Application.WorksheetFunction.EoMonth(DateSerial(localYear, LocalMonth, 1), 0)
Debug.Print "Le mois n'est pas renseigné le dernier jour : "; Day(localDate); " est défini par défaut."
Else
localDate = Application.WorksheetFunction.EoMonth(DateSerial(localYear, LocalMonth, localDay), 0)
End If
If justDay Then
CheckDate = Day(localDate)
Else
CheckDate = CDate(localDate)
End If
End FunctionVoici un petit test :
Public Sub TestDate()
Dim Madate As String
' // Ici on a une date sur une année bissextille et sans jour spécifié
Madate = "240200"
MsgBox "La date rectifieé pour cette saisie est : " & CheckDate(Madate, False)
' // Maitenant un année normale
Madate = "230200"
MsgBox "Le dernier jour du mois pour la date saisie est : " & CheckDate(Madate)
End Subet ses deux retours:
Tu peux constater que le dernier jour du moi de février 2024 est bien le 29, géré en transparence par Excel.
Petit commentaire: La gestion des dates en VBA sur deux chiffres pour l'année peut entrainer des résultats non voulus.
@Jean-Paul
J'en suis au début du programme, tout est là.
La fonction SetYear traite MyDate (la date au format YYMMDD) de telle sorte que La chaîne "YY" ne peut spécifier qu'une date comprise entre 49 ans dans le passé et 50 ans dans le futur avec comme pivot, l'année en cours.
Quand l'année en cours évolue, exemple l'année prochaine, le range passé -49, futur +50 évolue en conséquence.
Re,
Pas de problème les fonctions sont complémentaires. En fait la fonction que j'ai envoyé devrait se nommer SetDay par exemple. Donc dans les faits tu contrôle si la date est comprise entre -49 ans, aujourd'hui, et + 50 avec SetYear. Si oui tu met en forme avec SetDay.