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 !
Dim X As Integer
X = Format(Date, "ww", vbMonday, vbFirstFourDays)
est apparemment correcte. Pourtant elle renvoie un résultat erroné pour les dates suivantes :
30/12/1907
29/12/1919
31/12/1923
30/12/1935
29/12/1947
31/12/1951
30/12/1963
29/12/1975
31/12/1979
30/12/1991
29/12/2003
31/12/2007
30/12/2019
29/12/2031
31/12/2035
30/12/2047
29/12/2059
31/12/2063
30/12/2075
29/12/2087
31/12/2091
en se bornant aux XXème et XXIème siècles. On voit que le problème dépasse celui de l'habillage.
Il reste bien sûr la possibilité de faire le calcul à la main, ou de consulter un calendrier bien fait.
ROGER2327 #4557
Mardi 17 As 138 (Saint Pangloss, humoriste passif, SQ) 29 Brumaire An CCXIX 2010-W46-5T01:23:07Z
Il est vrai que j'aurai du préciser que la formule
Code:
Dim X As Integer
X = Format(Date, "ww", vbMonday, vbFirstFourDays)
Avait pour 1 jour tous les X ans qui ne collait pas.
On pourra donc choisir ce code VBA:
Code:
Function NumSem(sem As Range)
'MJ le 19/11/2010
NumSem = Format(sem, "ww", vbMonday, vbFirstFourDays)
'Le 19/11/2010 Problème pour certaines dates dont ...;43829;48211;49674;...
If sem = 43829 Then NumSem = 1
End Function
Sinon, il existe un autre formule très connue des Xldiens pour trouver le numéro de la semaine.
Sub Trouve_sem2()
'Affichage du n° de semaine
For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Rows.Row, 1))
cell.Offset(0, 1) = Evaluate("=INT((" & Format(cell.Value, "0") & "-SUM(MOD(DATE(YEAR(" & Format(cell.Value, "0") & "-MOD(" & Format(cell.Value, "0") & "-2,7)+3),1,2),{1E+99;7})*{1;-1})+5)/7)")
Next
End Sub
Function NumSem(sem As Range)
'MJ le 19/11/2010
NumSem = Format(sem, "ww", vbMonday, vbFirstFourDays)
'Le 19/11/2010 Problème pour certaines dates dont ...;43829;48211;49674;...
If sem = 43829 Then NumSem = 1
End Function
Sub Trouve_sem2()
'Affichage du n° de semaine
For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Rows.Row, 1))
cell.Offset(0, 1) = Evaluate("=INT((" & Format(cell.Value, "0") & "-SUM(MOD(DATE(YEAR(" & Format(cell.Value, "0") & "-MOD(" & Format(cell.Value, "0") & "-2,7)+3),1,2),{1E+99;7})*{1;-1})+5)/7)")
Next
End Sub
Excellente formule valable pour presque toutes les dates.
Quant à la transcription en VisualBasic, on pourra lui préférer
Code:
[COLOR=DarkSlateGray][B]Function toto(r)
Application.Volatile
Dim a&, b&
r = CDate(r)
a = r + 1 - Weekday(r, vbMonday)
b = DateSerial(Year(a + 3), 1, 1)
toto = (a - b + 6 + Weekday(b, vbMonday)) \ 7 + (Weekday(b, vbMonday) > 4)
End Function[/B][/COLOR]
pas plus compliquée, toujours valable, et plus de dix fois plus rapide. (Sur ma machine, s'entend…)
Mais tout cela ne répond pas au problème posé par victorien31 :
J'en profite pour donner une version un poil plus courte (mais pratiquement pas plus rapide) de la fonction ISO donnée dans le message #3 :
Code:
[COLOR=DarkSlateGray][B]Function ISO(r, Optional x As Boolean = False) [COLOR=DarkOrange]'Transcription ISO d'une date grégorienne.[/COLOR]
Application.Volatile
Dim a&, b&
r = CDate(r)
a = r - Weekday(r, vbMonday)
b = DateSerial(Year(a + 4), 1, 1)
ISO = Year(b) & "-W" & Format((a - b + Weekday(b, vbMonday)) \ 7 + (Weekday(b, vbMonday) > 4) + 1, "00") & IIf(x, "", "-" & Weekday(r, vbMonday))
End Function[/B][/COLOR]
ROGER2327 #4558
Mardi 17 As 138 (Saint Pangloss, humoriste passif, SQ) 29 Brumaire An CCXIX 2010-W46-5T23:55:17Z
En relisant, je m'aperçois que j'ai oublié une correction pour tenir compte des incohérences d'Excel. Ce que j'ai écrit n'est valable qu'à compter du premier mars 1900 inclus.
En effet, à partir de cette date, les jours sont comptés en prenant le 31 décembre 1899 pour jour 1. Le premier mars 1900 est ainsi le jour 61.
Mais, du premier janvier 1900 au 28 février 1900, les jours sont comptés en prenant le premier janvier 1900 pour jour 1. Le 28 février 1900 est le jour 59.
Dans ce système (bizarre), il n'y a pas de jour 60. Pour boucher le trou, le Bill's band a inventé un jour qui n'a jamais existé dans le calendrier grégorien : le 29 février 1900.
Comme le système est encore trop rationnel, il faut le saloper un peu plus. L'idée géniale est de décréter que le lundi premier janvier 1900 du calendrier grégorien est le dimanche premier janvier 1900 dans le calendrier du Bill's band. On continue ainsi jusqu'au mercredi 28 février 1900 (grégorien) baptisé mardi 28 février 1900.
Le 29 février 1900 qui n'a pas existé dans le calendrier grégorien trouve place dans le calendrier du Bill's band sous le nom de mercredi 29 février 1900.
Le premier mars 1900, jeudi dans le calendrier grégorien s'appelle… …jeudi dans le système du Bill'sband.!
Par chance, la coïncidence entre les deux systèmes semble continuer les jours suivants.
Quelques conséquences :
La fonction =JOURSEM(Date;2) renvoie le rang de Date dans la semaine (lundi = 1, … , dimanche = 7) si Date est postérieure au 28 février 1900. Pour Date allant du 1/1/1900 au 28/2/1900 inclus, la formule est fausse. Pour la rendre constamment juste, il faut écrire =JOURSEM(Date+(Date<61);2).
Il ne faut pas utiliser un format d'affichage de date commençant par "jjj " pour les dates antérieures au premier mars 1900 (car le nom du jour sera erroné).
Pour connaître le rang d'une date jj/mm/aaaaa en prenant le premier janvier 1900 comme jour 1, il faut prendre =DATE(aaaa;mm;jj) du 1/1/1900 au 28/2/1900, et =DATE(aaaa;mm;jj)-1 dans les autres cas. (On obtiendra ainsi 60 pour le 1/03/1900.)
…
Il en résulte que le code du message #18 doit être corrigé :
Code:
[COLOR=DarkSlateGray][B]Function ISO([COLOR=Red]ByVal[/COLOR] r, Optional x As Boolean = False) [COLOR=Sienna]'Transcription ISO d'une date grégorienne.
'x omis ou x = FAUX ou x = 0 : date ISO complète aaaa-WWSS-J
'x = VRAI ou x <> 0 : semaine ISO aaaa-WSS[/COLOR]
Application.Volatile
Dim a&, b&
r = CDate(r)
[COLOR=Red]r = r - (r < 61)[/COLOR]
a = r - Weekday(r, vbMonday)
b = DateSerial(Year(a + 4), 1, 1)
ISO = Year(b) & "-W" & Format((a - b + Weekday(b, vbMonday)) \ 7 + (Weekday(b, vbMonday) > 4) + 1, "00") & IIf(x, "", "-" & Weekday(r, vbMonday))
End Function[/B][/COLOR]
ROGER2327 #4559
Mercredi 18 As 138 (Saint Chambernac, pauvriseur, SQ) 30 Brumaire An CCXIX 2010-W46-6T15:50:27Z
Après une recherche qui m'a indiqué cette référence , je viens squatter ce fil 😀😀😀
Mon problème est exactement l'inverse :
je dispose du n° de semaine (saisi dans un USF), et je souhaiterais obtenir par macro semaine du ... au ... (pour l'insérer en tête d'un document word), sachant que, par exemple, si j'ai semaine 14 je dois obtenir semaine du 6 au 9 avril 2010 (eh oui, le lundi 5 est férié!!!)...
Pour les jours fériés, il faudrait créer une table quelquepart. Chez nous le lundi de pentecôte n'est pas travaillé (on nous pique un jour de RTT), donc il devra figurer comme férié. Mon problème c'est que je travaille sous Word, donc pas de table dans un classeur...😕 dommage! ... c'était trop simple!!
Comment je peux transformer ça en macro-commande, car la fonction ne me sert pas, il s'agit d'un fichier word
donc ma question est la suivante :
je récupère par saisie dans un userform un n° de semaine (de l'année en cours) et j'obtiens une variable (pas une cellule) contenant : semaine du ... au ... tu vois le truc??
Si l'usf est dans un fichier Excel essaie de t'inspirer de ceci
S'il faut travailler dans Word c'est un peu different et il faudrait je pense un fichier exemple
pierrejean a déjà bien avancé. J'ai repris son travail (il ne m'en voudra pas, je l'espère) en y adjoignant la détermination des jours fériés dans le code : on n'a plus besoin d'une plage dans la feuille. (On n'a plus besoin de feuille du tout, sauf pour y poser un bouton.)
Mais comme d'habitude, j'ai quelques cheveux à couper en quatre (au moins !) : qu'arrive-t-il si le jeudi de l'ascension tombe le dix mai ?
À bas la calotte !
Par exemple en 2018 :
2018-W19 = Le lundi 07 mai 2018, le mercredi 09 mai 2018 et le vendredi 11 mai 2018.
Les Français sont des fainéants !
Il y a donc encore du pain sur la planche…
Ensuite, reste l'adaptation à Word. Un support serait le bienvenu…
ROGER2327 #4625
Samedi 28 As 138 (Nativité de Saint Swift, chanoine, SQ) 10 Frimaire An CCXIX 2010-W48-2T00:52:51Z
Je vais tenter de m'y coller... grâce à Excel et VBscript 😉
(Comme j'ai peu de temps ce matin (boulot oblige), voici un code VBA tout prêt *(Merci à Dev Ashish)
* qui illustre où je veux en venir: utiliser Excel dans Word par Automation
VB:
'************* Code Start ****************
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Sub sRunCARMa()
Dim objXL As Object, x
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True 'Mettre à False pour utiliser avec Word
'Open the Workbook
.Workbooks.Open "C:\Temp\NumSem.xls" 'ici nom classeur pour l'exemple
'Include CARMA in menu, run AutoOpen
'.ActiveWorkbook.RunAutoMacros xlAutoOpen à adapter ou supprimer
'x = .Run("AccountsViewEngine", 0) ' à adapter ou supprimer
End With
Set objXL = Nothing
End Sub
'************* Code End ****************
Je pense que vous voyez ou je veux en venir.
Je repasserai plus tard, si d'autres parmi nous n'ont pas explorer plus avant cette voie.
Pour le jeudi je m'en fiche Niark! la semaine sera toujours du lundi au vendredi mais tu me fais penser qu'un jour férié (le 8 mai par exemple) peut aussi tomber ... un vendredi!!! Ah mais oui, tu as raison, et si le jeudi de l’ascension tombe un 7 mai la semaine va du lundi au mercredi ! Damned 🙁🙁🙁! J’avais pas pensé à ça !!!
Edit : j'ai testé, Roger, ça fonctionne SUPERRRRRRR!!!!!
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = CreateObject("Word.application")
With WordApp
.Visible = False 'masque l'application mettre à True pour les tests sinon on ne voit pas ce qui se passe dans Word
.Documents.Open FileName:= "C:\Temp\NumSem.xls" 'ici nom classeur pour l'exemple
End With
Set WordDoc = WordApp.Documents.Open("C:\Temp\NumSem.xls") 'ici nom classeur pour l'exemple
Set WordApp = Nothing
- 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