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

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
799
  • Question Question
XL 2019 3 repertoires
Réponses
2
Affichages
392
  • Question Question
Microsoft 365 appel des sous-routine
Réponses
3
Affichages
209

Statistiques des forums

Discussions
315 283
Messages
2 118 012
Membres
113 407
dernier inscrit
FITAS