XL 2016 Condition avec reprise de date antérieurs

  • Initiateur de la discussion Initiateur de la discussion VBA
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

VBA

XLDnaute Nouveau
Bonjour,

J'ai un petit programme vba qui tourne pour lancer des extractions de la semaine d'avant via l'erp de l'entreprise et j'ai mis en place une boucle qui me permet de prendre le lundi de la semaine d'avant jusqu''au vendredi de la semaine d'avant.
C'est un calcul tout simple qui prend le jour actuel et qui le soustrait au nombre de jour qu'il faut pour arrivé au lundi de la semaine d'avant. Il fait la même chose pour le vendredi.
Mon problème est le suivant c'est qu'en début de mois si je lance l'extraction aujourdhui soit le lundi 07 mai il doit aller chercher le lundi 30 Avril chose qu'il ne fait pas, il va rentre 00/05/2018.
Je voudrais savoir si vous pouvez m'aider pour une petite boucle qui prend en compte le mois et moi renvoi la date correcte.
Voici le code ci dessous.
Merci.

VB:
dim d 'date à traiter
dim stJs ' chaine jour de la semaine..
d = now ' date actuelle
stJS = WeekDayName(WeekDay(d))

If stJS = "lundi" Then
    jour = Day(Now) - 7 & "." & Month(Now) & "."  & Year(Now)
    jour2 = Day(Now) - 3 & "." &  Month(Now) & "." & Year(Now)
ElseIf stJS = "mardi" Then
    jour = Day(Now) - 8 & "." & Month(Now) & "."  & Year(Now)
    jour2 = Day(Now) - 4 & "." &  Month(Now) & "." & Year(Now)
ElseIf stJS = "mercredi" Then
    jour = Day(Now) - 9 & "." & Month(Now) & "."  & Year(Now)
    jour2 = Day(Now) - 5 & "." &  Month(Now) & "." & Year(Now)
ElseIf stJS = "jeudi" Then
    jour = Day(Now) - 10 & "." & Month(Now) & "."  & Year(Now)
    jour2 = Day(Now) - 6 & "." &  Month(Now) & "." & Year(Now)
ElseIf stJS = "vendredi" Then
    jour = Day(Now) - 11 & "." & Month(Now) & "."  & Year(Now)
    jour2 = Day(Now) - 7 & "." &  Month(Now) & "." & Year(Now)
End IF
 
Bonjour,
Essayez ceci

Dim d 'date à traiter
Dim stJs ' chaine jour de la semaine..
d = Now ' date actuelle
stJs = WeekdayName(Weekday(d), , 1)

If stJs = "lundi" Then
jour = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 7)
jour2 = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 3)
ElseIf stJs = "mardi" Then
jour = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 8)
jour2 = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 4)
ElseIf stJs = "mercredi" Then
jour = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 9)
jour2 = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 5)
ElseIf stJs = "jeudi" Then
jour = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 10)
jour2 = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 6)
ElseIf stJs = "vendredi" Then
jour = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 11)
jour2 = CDate(CDate(Day(Now) & "/" & Month(Now) & "/" & Year(Now)) * 1 - 7)
End If

Cdlt
 
Sa fonctionne bien mais le seul problème c'est que l'erp il accepte la date sous format xx.xx.xxxx et non xx/xx/xxxx.
Et quand je fais le changement sa m'indique une erreur d'incompatibilité avec le CDate.

cdate.PNG
 
Bonjour le fil, Re VBA, Rouge

Une petite fonction personnalisée qui pourrait avoir son utilité ici.
(ci-dessous la fonction et des exemples basiques d'emploi)
NB: JOURPOUS pour JOURPrécédentOUSuivant
VB:
Sub Exemples_Utilisation()
'lundi et vendredi précédents aujourd'hui
MsgBox JOURPOUS(Date, -1, vbMonday)
MsgBox JOURPOUS(Date, -1, vbFriday)

'lundi et vendredi suivants aujourd'hui
MsgBox JOURPOUS(Date, 1, vbMonday)
MsgBox JOURPOUS(Date, 1, vbFriday)
End Sub
Private Function JOURPOUS(j As Date, PlusMoins As Integer, jsem As VbDayOfWeek)
JOURPOUS = DateAdd("ww", PlusMoins, j - (Weekday(j)) + jsem)
End Function
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Problème de date
Réponses
5
Affichages
161
Retour