Remplir un calendrier
Le
Apitos

Bonjour à tous,
J'aimerais remplir un calendrier avec du code VBA en utilisant les code sui=
vant :
'--
Sub test()
Dim Mois As Integer, Jour As Integer, m As Long
Dim dDate As Date, Ligne As Byte
Ligne = 3
For m = 1 To 12
dDate = Format(DateSerial(Year(Date), Month(Date), 1), "dd/mm/yy"=
)
Mois = m
MsgBox "Mois : " & m
Jour = 0
With Feuil2
.Range("A1").Value = Application.Proper(Format(DateSerial(201=
5, Mois, 1), "mmmm"))
' Efacement de la zone du mois
[modele].Offset(3).ClearContents
For i = 3 To 8
For j = 1 To 7
Debug.Print "Colonne : " & .Cells(i, j).Column, "Weekda=
y : " & Weekday(dDate, 2)
Debug.Print "Mois : " & Month(DateSerial(2015, Mois, Jo=
ur)), "Mois jour-1 : " & Month(DateSerial(2015, Mois, Jour - 1))
If i = 3 And .Cells(i, j).Column < Weekday(dDate, 2) =
Then
Cells(i, j) = ""
Else
Jour = Jour + 1
If Jour <= Day(DateSerial(2015, Mois, 0)) Then
.Cells(i, j) = Jour
If Jour = 1 Then .Cells(i, j).Font.ColorIndex=
= 3
End If
End If
Next j
If j = 8 And Application.CountA(.Range(.Cells(i, 1), .Cel=
ls(i, 8))) > 0 Then
.Cells(i, j) = ""
.Cells(i, 8) = Application.WeekNum(DateSerial(2015, M=
ois, _
Applicati=
on.Min(.Range(.Cells(i, 3), .Cells(i, 8)))))
End If
Next i
If m Mod 2 <> 0 Then
[modele].Copy Feuil1.Range("A" & Ligne)
Else
[modele].Copy Feuil1.Range("J" & Ligne)
Ligne = Ligne + 9
End If
End With
Next m
End Sub
'--
Mais malheureusement les mois ne sont pas remplis correctement ainsi que le=
s numéros des semaines !
http://cjoint.com/?ECmwRk7r52n
Merci d'avance.
J'aimerais remplir un calendrier avec du code VBA en utilisant les code sui=
vant :
'--
Sub test()
Dim Mois As Integer, Jour As Integer, m As Long
Dim dDate As Date, Ligne As Byte
Ligne = 3
For m = 1 To 12
dDate = Format(DateSerial(Year(Date), Month(Date), 1), "dd/mm/yy"=
)
Mois = m
MsgBox "Mois : " & m
Jour = 0
With Feuil2
.Range("A1").Value = Application.Proper(Format(DateSerial(201=
5, Mois, 1), "mmmm"))
' Efacement de la zone du mois
[modele].Offset(3).ClearContents
For i = 3 To 8
For j = 1 To 7
Debug.Print "Colonne : " & .Cells(i, j).Column, "Weekda=
y : " & Weekday(dDate, 2)
Debug.Print "Mois : " & Month(DateSerial(2015, Mois, Jo=
ur)), "Mois jour-1 : " & Month(DateSerial(2015, Mois, Jour - 1))
If i = 3 And .Cells(i, j).Column < Weekday(dDate, 2) =
Then
Cells(i, j) = ""
Else
Jour = Jour + 1
If Jour <= Day(DateSerial(2015, Mois, 0)) Then
.Cells(i, j) = Jour
If Jour = 1 Then .Cells(i, j).Font.ColorIndex=
= 3
End If
End If
Next j
If j = 8 And Application.CountA(.Range(.Cells(i, 1), .Cel=
ls(i, 8))) > 0 Then
.Cells(i, j) = ""
.Cells(i, 8) = Application.WeekNum(DateSerial(2015, M=
ois, _
Applicati=
on.Min(.Range(.Cells(i, 3), .Cells(i, 8)))))
End If
Next i
If m Mod 2 <> 0 Then
[modele].Copy Feuil1.Range("A" & Ligne)
Else
[modele].Copy Feuil1.Range("J" & Ligne)
Ligne = Ligne + 9
End If
End With
Next m
End Sub
'--
Mais malheureusement les mois ne sont pas remplis correctement ainsi que le=
s numéros des semaines !
http://cjoint.com/?ECmwRk7r52n
Merci d'avance.
Ai-je oublié un détail ?
1. création mois de février (en A3)
2. copie(automatiquement par macro) en J3
3. création mois de mars(en A3)
4. copie(automatiquement par macro) en A11
le tout dans une boucle, en terminant par janvier.
Daniel
Le 2015-03-13 11:50, Apitos a écrit :
seulement 1 ;-)
est ce que la première semaine doit être pleine pour être la semaine 1 ?
si oui, il faudra modifier la ligne suivante
If c.Column = 7 Or Application.CountA(.Range(.Cells(c.Row, 1), .Cells(c.Row,
7))) = 7 Then s = s + 1: .Cells(c.Row, 8) = s
http://cjoint.com/?ECoemYcA6A8
Sub test()
Dim i As Integer, x As Integer, s As Integer, nbj As Integer
Dim cl As Integer, ans As Integer, c As Range, jm, Position, mmm
ans = Year(Now)
mmm = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet",
"Août", "Septembre", "Octobre", "Novembre", "Décembre")
Position = Array("A3", "J3", "A12", "J12", "A21", "J21", "A30", "J30", "A39",
"J39", "A48", "J48")
'année bissextile
If (ans Mod 4) = 0 And (ans Mod 100) > 0 Or (ans Mod 400) = 0 Then
jm = Array(0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
Else
jm = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
End If
Sheets("Feuil1").Range("A3:Q56").ClearContents
Application.ScreenUpdating = False
For i = 1 To 12
Sheets("Feuil2").Range("A3:H8").ClearContents
nbj = jm(i)
cl = Choose(Weekday(DateSerial(ans, i, 1)), 7, 1, 2, 3, 4, 5, 6)
Sheets("Feuil2").Range("A1") = mmm(i - 1)
For Each c In Sheets("Feuil2").Range("A3:G8")
If Not (c.Column < cl And x = 0) Then
If x >= nbj Then x = 0: Exit For
x = x + 1
Sheets("Feuil2").Range(c.Address) = x
End If
If c.Column = 7 Or Application.CountA(.Range(.Cells(c.Row, 1),
.Cells(c.Row, 7))) = 7 Then s = s + 1: .Cells(c.Row, 8) = s
Next
Application.ScreenUpdating = True
Sheets("Feuil2").Range("A1:H8").Copy Sheets("Feuil1").Range(Position(i - 1))
Application.CutCopyMode = False
Next
End Sub
isabelle
il faudra modifier la ligne suivante:
If c.Column = 7 Or Application.CountA(.Range(.Cells(c.Row, 1), .Cells(c.Row,
7))) = 7 Then s = s + 1: .Cells(c.Row, 8) = s
par:
If i = 1 And Application.CountA(.Range(.Cells(c.Row, 1),
.Cells(c.Row, 7))) = 7 Then
s = s + 1: .Cells(c.Row, 8) = s
ElseIf i <> 1 And c.Column = 7 Or
Application.CountA(.Range(.Cells(c.Row, 1), .Cells(c.Row, 7))) = 7 Then
s = s + 1: .Cells(c.Row, 8) = s
End If
isabelle
Avec ces boucles, tu ne rentrera jamais dans ton if, la variable j ne
sera jamais égale à 8 :')
Le 14/03/2015 05:31, isabelle a écrit :
in french (ou selon la norme iso machin chose) la semaine 1 est celle
qui contient au moins 4 jours.
Donc, sont considérés comme semaine 1 les semaines qui commence par un
lundi, mardi, mercredi ou jeudi.
une suite ici http://fr.wikipedia.org/wiki/Semaine_1
Ceci dit, je n'ai pas compris le besoin de Apitos de faire un calendrier
en macro car il me semble qu'il faut modifier pas mal de chose à chaque
changement d'année, non ?
Quelques formules et un peu de mise en forme conditionnelle permettrait
d'avoir un calendrier perpétuel, non ?
--
JièL ex matricule DX32767
en amérique la majorités des cie ne respecte pas cette norme, alors il faut adapté
dans l'exemple que j'ai fait il n'y a que le chiffre de l'année à changer,
http://cjoint.com/?ECopT00qbw8
isabelle
Le 2015-03-14 05:42, JièL a écrit :
Merci pour Isabelle pour le code.
Je vais en faire des essais.
En réponse à Jièl, le but final de ce calendrier et d'avoir pour chaq ue mois une feuille avec un calendrier complet et sur n'importe quel feuill e de mois quand je clique sur une cellule (une journée) d'un tableau de m ois pour voir les taches accomplis dans une même journée, je serais d irigé vers la feuille du mois correspondant ainsi que la ligne correspond ante ou j'ai cliqué.
Exemple : Quand je clique dans la cellule de la journée 12 du mois de f évrier, je serais dirigé vers la feuille "Février" sur la ligne corre spondante dans les colonne T à Y.
Les numéros des semaines, je m'en servirais pour générer un rapport h ebdomadaire des taches effectues.
A la fin de chaque mois, il y aura un rapport mensuel générer depuis me s 12 feuilles des mois de l'année en cours.
Un classeur joint qui illustre la disposition des 12 mois.
http://cjoint.com/?ECovoQFmLKI
Je crois me souvenir d'une très ancienne discussion à ce sujet.
Les Ussiens et les européens n'ont pas le même critère pour démarrer la
notation des semaines.
Je crois me souvenir (???) que LL avait résumé en disant que ici (en
Europe), la première semaine était celle qui contenait le premier jeudi.
Mais , en cas d'erreur, je plaide déjà non coupable car mon neurone est en
WE.
Jacques.
Jacquouille
" Le vin est au repas ce que le parfum est à la femme."
"isabelle" a écrit dans le message de groupe de discussion :
me1gvc$3eb$
bonjour JièL,
en amérique la majorités des cie ne respecte pas cette norme, alors il faut
adapté
dans l'exemple que j'ai fait il n'y a que le chiffre de l'année à changer,
http://cjoint.com/?ECopT00qbw8
isabelle
Le 2015-03-14 05:42, JièL a écrit :
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avec Excel 2013, on a une fonction : NO.SEMAINE.ISO, sans paramètre
pour les semaines norme européenne et commençant le lundi.
Avec Excel 2010, on a une version améliorée de NO.SEMAINE :
https://support.office.com/fr-be/article/NOSEMAINE-NOSEMAINE-fonction-e5c43a03-b4ab-426c-b411-b18c13c75340
Avant... merci les formules à rallonge.
Cordialement.
Daniel