XL 2016 Condition avec reprise de date antérieurs

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
 

Rouge

XLDnaute Impliqué
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
 

VBA

XLDnaute Nouveau
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
 

Staple1600

XLDnaute Barbatruc
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
 

Discussions similaires

Réponses
2
Affichages
252