XL 2016 Cherche code vba pour récupérer des dates

[Anais0998]

Bonjour à tous,

Je cherche depuis quelques jours sans trouver la solution j'espère pouvoir trouver de l'aide parmi vous.

Grâce à des codes trouvés sur le net, j'ai réussi à mettre en place ce petit calendrier perpétuel, qui, grâce au code que j'ai posté plus bas, me renvoie, lorsque je clique dans la cellule (date) du calendrier, la date complète dans la cellule indiquée dans le code.

Ce que j'ai besoin d'obtenir, c'est 4 dates complètes. Donc comment pourrait-on faire en sorte qu'en cliquant sur les différentes cellules à la suite, chaque date soit renvoyée dans des cellules précisées dans le code.
Je vous remercie d'avance pour votre aide précieuse, bonne journée à tous.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheets("ACCUEIL2")
If Not Intersect(Target, Range("B13:H18")) Is Nothing Then
Range("D22").Value = Target.Value
End If
End With
End Sub

 

[pierrejean]

Bonjour Anais0998

A tester

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheets("ACCUEIL2")
Destination = Array("D22", "D23", "D24", "D25")
If Not Intersect(Target, Range("B13:H18")) Is Nothing Then
    Range(Destination(NbDate)).Value = Target.Value
    MsgBox (Range(Destination(NbDate)).Address)
    NbDate = NbDate + 1
    If NbDate = 4 Then NbDate = 0
 End If
End With
End Sub

avec dans un module

Public NbDate

Les destinations des dates sont a mettre dans l'Array du debut de la macro

 

[Anais0998]

Bonjour pierrejean et merci pour ton retour.

Je pratique depuis peu en vba et j'avoue n'avoir encore jamais travaillé avec les tableaux (array) en vba.
J'ai testé ton code mais le résultat n'est pas celui escompté : quelle que soit la cellule sélectionnée, dans le calendrier, c'est toujours la cellule ("D22") qui renvoie la date. Or, et peut-être que je ne me suis pas bien exprimée dans ma requête, j'aimerais que la 1ère cellule sélectionnée s'affiche dans ("D22"), la seconde dans ("D23"), la 3ème dans ("D24") et la 4ème dans ("D25"), puis on recommence à ("D22").

Je m'y suis certainement mal prise avec ton code, notamment avec Public NbDate, et je n'ai pas vraiment compris ta dernière phrase (les destinations des dates sont à mettre dans l'array du début de la macro).

En espérant que tu voudras bien m'en dire plus pour que j'obtienne le résultat souhaité, je te souhaite en attendant un bon dimanche.

 

[pierrejean]

Re

Voir ce classeur

 

[Anais0998]

Re

Voir ce classeur

Un grand merci à toi pierrejean, ça fonctionne parfaitement, tu m'as enlevé un sacré épine du pied parce que je pense que j'aurai mouliné pendant un bon moment avant de trouver la solution. Il me reste une dernière chose que j'aimerais pouvoir faire, c'est appliquer une MEFC sur les cellules sélectionnées du calendrier, pour colorier le fond par exemple, j'ai testé quelques trucs déjà mais rien ne fonctionne, et la difficulté sera surtout d'appliquer la MFEC si='il y a chevauchement d'une année sur l'autre. Si tu as encore un peu de temps à m'accorder aurais tu une idée pour m'orienter dans ma recherche stp ? D'avance, encore mille fois merci pour ta générosité et bonne journée.

 

[pierrejean]

Re

Pour ce faire il me faudrait avoir le calendrier dans un fichier exemple (sans données confidentielles)

 

[job75]

Bonjour Anais0998, Pierre,

Voyez le fichier joint et cette macro :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static NbDate As Byte 'mémorise la variable
Dim Destination, Adr(3) As String, i As Byte
Destination = Array("D22", "D23", "D24", "D25")
If Intersect(ActiveCell, Range("B13:H18")) Is Nothing Then Exit Sub
Sheets("ACCUEIL2").Range(Destination(NbDate)) = ActiveCell
If IsArray([memo]) Then
    For i = 0 To 3
        Adr(i) = Application.Index([memo], i + 1) 'récupère les adresses mémorisées
    Next
End If
Adr(NbDate) = ActiveCell.Address 'nouvelle adresse
ThisWorkbook.Names.Add "Memo", Adr 'mémorisation dans un nom défini
NbDate = NbDate + 1
If NbDate = 4 Then NbDate = 0
End Sub

Les adresses des cellules à colorer sont stockées dans le nom défini Memo.

Ce nom est utilisé dans la formule de la MFC =OU(ADRESSE(LIGNE();COLONNE())=Memo)

A+

 

[Anais0998]

Re

Pour ce faire il me faudrait avoir le calendrier dans un fichier exemple (sans données confidentielles)

Bonjour pierrejean,
Ci-joint un "bout" de fichier contenant le calendrier "ACCUEIL2". J'ai supprimé tous les onglets avec informations confidentielles.
Merci pour ton aide.

 

[Anais0998]

Bonjour Anais0998, Pierre,

Voyez le fichier joint et cette macro :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static NbDate As Byte 'mémorise la variable
Dim Destination, Adr(3) As String, i As Byte
Destination = Array("D22", "D23", "D24", "D25")
If Intersect(ActiveCell, Range("B13:H18")) Is Nothing Then Exit Sub
Sheets("ACCUEIL2").Range(Destination(NbDate)) = ActiveCell
If IsArray([memo]) Then
    For i = 0 To 3
        Adr(i) = Application.Index([memo], i + 1) 'récupère les adresses mémorisées
    Next
End If
Adr(NbDate) = ActiveCell.Address 'nouvelle adresse
ThisWorkbook.Names.Add "Memo", Adr 'mémorisation dans un nom défini
NbDate = NbDate + 1
If NbDate = 4 Then NbDate = 0
End Sub

Les adresses des cellules à colorer sont stockées dans le nom défini Memo.

Ce nom est utilisé dans la formule de la MFC =OU(ADRESSE(LIGNE();COLONNE())=Memo)

A+

Bonjour job75,
Merci pour ton aide, je regarde ça et je te dis si ça fonctionne.
Bonne journée

 

[pierrejean]

Re

A tester: Une méthode de Bourrin par rapport à celle de mon ami Gerard

 

[Anais0998]

Re

A tester: Une méthode de Bourrin par rapport à celle de mon ami Gerard

C'est presque parfait, merci bcp pierrejean. Je vais tenter de trouver un moyen pour que les mefc respectent les changements de sélection de mois et d'année,car pour le moment le calendrier garde en mémoire les mefc et du coup des cellules non sélectionnées sont coloriées lors du passage d'un mois à l'autre ou d'une année à l'autre.

 

[pierrejean]

Re

A tester (il y a probablement des cas non prévus !!)
Mais j’espère que Gerard pourra mettre en place sa solution

 

[job75]

j’espère que Gerard pourra mettre en place sa solution

Dans ce fichier (2) j'ai juste supprimé la variable "Destination" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static NbDate As Byte 'mémorise la variable
Dim Adr(3) As String, i As Byte
If Intersect(ActiveCell, Range("B13:H18")) Is Nothing Then Exit Sub
If IsArray([memo]) Then
    For i = 0 To 3
        Adr(i) = Application.Index([memo], i + 1) 'récupère les adresses mémorisées
    Next
End If
Adr(NbDate) = ActiveCell.Address 'nouvelle adresse
ThisWorkbook.Names.Add "Memo", Adr 'mémorisation dans un nom défini
NbDate = NbDate + 1
If NbDate = 4 Then NbDate = 0
End Sub

 

[job75]

Notez que je ne m'occupe pas du tout de placer les dates dans le rectangle.

Car cela est tout à fait inutile... sauf si l'on est daltonien.

 

[Anais332*192]

Notez que je ne m'occupe pas du tout de placer les dates dans le rectangle.

Car cela est tout à fait inutile... sauf si l'on est daltonien.

Bonjour job75,
Merci bcp pour ton aide précieuse, j'ai testé le fichier que tu as posté mais le résultat n'est toujours pas celui escompté. Je pense que je vais abandonner cette option de MEFC sur les dates sélectionnées, car le principal pour moi étant que ces dates soient reportées dans le "rectangle", car à partir de là je m'en sers pour générer les codes "sessions", et aussi je les rapatrie dans les PV de résultats, déroulement d'épreuves, etc ... Donc indispensable pour moi. J'aurais aimé avoir le visuel des dates, car il y a 3 sortes de formations qui durent de 1 à 4 jours, voilà c'était juste pour avoir un visuel sur le calendrier, mais la problématique étant que les dates peuvent s'étaler d'un mois à un autre, voire d'une année à une autre, et là ça se complique car en changeant le mois ou l'année, la cellule préalablement sélectionnée le reste . Si tu vois un moyen de résoudre ça je suis preneuse bien sûr. Encore un grand merci en tout cas d'avoir pris le temps de te pencher sur ma requête.