Mise en place dans calendrier en fonction de la date

Hello,

idem, je lis les commentaires dans les macros, c'est ainsi qu'on avance :)

Patrick


"Jacquouille" <j.thiernesse@skynet.be> a écrit dans le message de news:
mbktg6$kb0$1@speranza.aioe.org...

Hello

Perso, je suis incapable de pondre des macros de ce genre.
Par contre, j'aime lire les commentaires car ils me permettent (parfois)
de comprendre ces termes barbares.Tu sais mettre le code ici, que j'aie de
la lecture pour les longues soirées d'hiver?
déjà merci
Jacques.



Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"DanielCo" a écrit dans le message de groupe de discussion :
mbkleb$t5o$1@speranza.aioe.org...

C'est fait. Utilise le même lien pour accéder au classeur.
Daniel

Alors ça c'est tres sympa

je me suis couché à 2heures du mat mais je n'etais plus étanche

merci beaucoup

---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com

---
L'absence de virus dans ce courrier electronique a ete verifiee par le logiciel antivirus Avast.
http://www.avast.com

salutatous,

voilà pour la lecture,

Sub Remplissage()
Dim C As Range, Plage As Range, I As Integer, Ans As Range
Dim Ligne As Long, Sh As Worksheet, Lig As Integer, Mois As Integer, An As
Integer
Dim Col As Integer, DerCol As Integer
Set Sh = Sheets("Feuil1")
With Sheets("Feuil1")
'"Ans" est la variable représentant les années de la ligne 2 de Feuil1
Set Ans = .Range("B2", .Cells(2, .Columns.Count).End(xlToLeft))
End With
With Sheets("tables")
'"Ligne" représente la dernière ligne de la colonne A de "tables" (8
pour ce classeur)
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
'DerCol représente la dernière colonne de Feuil1
DerCol = Sh.Cells(3, Sh.Columns.Count).End(xlToLeft).Column
'Plage représente le tableau B3:AE31 de tables
Set Plage = .Range("C2", .Cells(Ligne, .Columns.Count).End(xlToLeft))
'on boucle sur les numéros de la colonne A de tables
For Each C In .Range("A4", .Cells(.Rows.Count, 1).End(xlUp))
'si on trouve le numéro sur Feuil1
If IsNumeric(Application.Match(C.Value, Sh.[B:B], 0)) Then
'"Lig" représente la ligne du numéro sur Feuil1
Lig = Application.Match(C.Value, Sh.[B:B], 0)
'on boucle sur les cellules de la ligne du numéro sur Feuil1
For I = 3 To DerCol
'si c'est une date
If IsDate(.Cells(C.Row, I).Value) Then

'si la cellule correspondante de la ligne 2 n'est pas vide
If .Cells(2, I) <> "" Then
'calcul du mois et de l'année
Mois = Month(.Cells(C.Row, I))
An = Year(.Cells(C.Row, I))
'si l'année est > 0 (valeur de la cellule =0)
If An > 1901 Then
'si l'année de la cellule existe en ligne 2 de
Feuil1
If IsNumeric(Application.Match(An, Ans, 0)) Then
'calcul de la colonne correspondante au
moois et à l'année
Col = Application.Match(An, Ans, 0) + Mois
'écriture dans la cellule de Feuil1 de la
valeur trouvée
Sh.Cells(Lig, Col).Value = .Cells(2, I).Value
End If
End If
End If
End If
Next I
End If
Next C
End With
End Sub


Le 2015-02-13 08:16, Jacquouille a écrit :

Hello

Perso, je suis incapable de pondre des macros de ce genre.
Par contre, j'aime lire les commentaires car ils me permettent (parfois) de
comprendre ces termes barbares.Tu sais mettre le code ici, que j'aie de la
lecture pour les longues soirées d'hiver?
déjà merci
Jacques.



Jacquouille

Hello
Merci Isabelle
Pour Daniel: au cas où tu n'aurais pas mon adresse:
j point thiernesse arobase skynet point be

C'est ma femme qui va être contente: voilà des soirées bien remplies. -))
grand merci et bon vendredi 13

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"DanielCo" a écrit dans le message de groupe de discussion :
mbl0q3$t03$1@speranza.aioe.org...

Salut,
Non, je ne peux pas mettre plus de 10 lignes dans un post sans recevoir
un message d'erreur. C'est pour ça que j'ai mis un lien sur le
classeur. Est-ce que tu peux récupérer le classeur ?
Cordialement.
Daniel

Hello

Perso, je suis incapable de pondre des macros de ce genre.
Par contre, j'aime lire les commentaires car ils me permettent (parfois)
de comprendre ces termes barbares.Tu sais mettre le code ici, que j'aie de
la lecture pour les longues soirées d'hiver?
déjà merci
Jacques.



Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"DanielCo" a écrit dans le message de groupe de discussion :
mbkleb$t5o$1@speranza.aioe.org...

C'est fait. Utilise le même lien pour accéder au classeur.
Daniel

Alors ça c'est tres sympa

je me suis couché à 2heures du mat mais je n'etais plus étanche

merci beaucoup

---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com

---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com

merci pour tout

et ce qui est génial c'est qu'il y a du monde sur la fréquence

bon vendredi 13 ET BON WEEK END

Merci pour ton adresse. Je suppose que tu as la mienne ;
d point colardelle arobase free point fr.
Daniel

bon je viens de me faire toute la procedure pas à pas, genial, c'est vrai ment bien fichu

en revanche, si par hasard je retire une date et relance la procedure, cel a n'efface pas le calendrier avant de remettre les nouvelles valeurs

il n(y aurait pas une formule magique avant la boucle genre .(lig,col).dele te

ca serait bien cool

Si c'est la deuxième étape. Associer une macro événementielle pour
exécuter la macrco à chaque changement.Je le fais dès que possible.
Daniel

bon je viens de me faire toute la procedure pas à pas, genial, c'est vraiment
bien fichu

en revanche, si par hasard je retire une date et relance la procedure, cela
n'efface pas le calendrier avant de remettre les nouvelles valeurs

il n(y aurait pas une formule magique avant la boucle genre .(lig,col).delete

ca serait bien cool

J'ai modifié le classeur en ajoutant la macro suivante dans
ThisWorkbook :
'la macro se déclenche en cas de changement de valeur
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim Ligne As Long, Col As Integer
'modification sur Feuil1
If Sh.Name = "Feuil1" Then
'calcul de la dernière colonne de la plage
Col = Cells(3, Columns.Count).End(xlToLeft).Column
'si la modification concerne la colonne B ou la plage années -
mois
If (Target.Column = 2 And Target.Row > 3) Or Not
Intersect(Range("C2", Cells(3, Col)), _
Target) Is Nothing Then
'recalcul général
Remplissage
End If
'modification sur "tables"
ElseIf Sh.Name = "tables" Then
'calcul de la ligne du dernier numéro
Ligne = Cells(Rows.Count, 1).End(xlUp).Row
'calcul de la dernière colonne de la plage
Col = Cells(3, Columns.Count).End(xlToLeft).Column
'si la modification concerne la colonne A ou la plage des dates
If (Target.Column = 1 And Target.Row > 3) Or Not
Intersect(Range("B2", Cells(Ligne, Col)), _
Target) Is Nothing Then
Remplissage
End If
End If
End Sub

J'ai aussi ajouté un "EnableEvents" au début et à la fin de la macro
Remplissage.
Enfin, Il est possible d'optimiser la macro :
- en ne recalculant que la oou les lignes nécessaires
- en utilisant un array.
Fichier : http://cjoint.com/?EBomffv2IA4

Daniel

bon je viens de me faire toute la procedure pas à pas, genial, c'est vraiment
bien fichu

en revanche, si par hasard je retire une date et relance la procedure, cela
n'efface pas le calendrier avant de remettre les nouvelles valeurs

il n(y aurait pas une formule magique avant la boucle genre .(lig,col).delete

ca serait bien cool

salut Daniel

génial ce que tu as fais

j'ai fais des test mais je me suis rendu compte par exemple que si l'on mod ifiait une date cela n'enlevait pas son code dans le calendrier en Feuil1

j'ai peut être loupé un morceaux

Salut,
Juste, il faut effacer la plage avant :
Sub Remplissage()
Dim C As Range, Plage As Range, I As Integer, Ans As Range
Dim Ligne As Long, Sh As Worksheet, Lig As Integer, Mois As
Integer, An As Integer
Dim Col As Integer, DerCol As Integer
Application.EnableEvents = False
Set Sh = Sheets("Feuil1")
With Sheets("Feuil1")
'"Ans" est la variable représentant les années de la ligne 2 de
Feuil1
Set Ans = .Range("B2", .Cells(2, .Columns.Count).End(xlToLeft))
.Range("B4", .Cells(.Rows.Count, 2).End(xlUp)).Offset(,
1).Resize(, 12).ClearContents
End With
With Sheets("tables")
'"Ligne" représente la dernière ligne de la colonne A de
"tables" (8 pour ce classeur)
Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
'DerCol représente la dernière colonne de Feuil1
DerCol = Sh.Cells(3, Sh.Columns.Count).End(xlToLeft).Column
'Plage représente le tableau B3:AE31 de tables
Set Plage = .Range("C2", .Cells(Ligne,
.Columns.Count).End(xlToLeft))
'on boucle sur les numéros de la colonne A de tables
For Each C In .Range("A4", .Cells(.Rows.Count, 1).End(xlUp))
'si on trouve le numéro sur Feuil1
If IsNumeric(Application.Match(C.Value, Sh.[B:B], 0)) Then
'"Lig" représente la ligne du numéro sur Feuil1
Lig = Application.Match(C.Value, Sh.[B:B], 0)
'on boucle sur les cellules de la ligne du numéro sur
Feuil1
For I = 3 To DerCol
'si c'est une date
If IsDate(.Cells(C.Row, I).Value) Then

'si la cellule correspondante de la ligne 2
n'est pas vide
If .Cells(2, I) <> "" Then
'calcul du mois et de l'année
Mois = Month(.Cells(C.Row, I))
An = Year(.Cells(C.Row, I))
'si l'année est > 0 (valeur de la cellule
=0)
If An > 1901 Then
'si l'année de la cellule existe en
ligne 2 de Feuil1
If IsNumeric(Application.Match(An, Ans,
0)) Then
'calcul de la colonne
correspondante au moois et à l'année
Col = Application.Match(An, Ans, 0)
+ Mois
'écriture dans la cellule de Feuil1
de la valeur trouvée
Sh.Cells(Lig, Col).Value =
.Cells(2, I).Value
End If
End If
End If
End If
Next I
End If
Next C
End With
Application.EnableEvents = True
End Sub
Daniel

salut Daniel

génial ce que tu as fais

j'ai fais des test mais je me suis rendu compte par exemple que si l'on
modifiait une date cela n'enlevait pas son code dans le calendrier en Feuil1

j'ai peut être loupé un morceaux