XL 2016 [Résolu] Macro pour positionner un tableau à la date du jour et à la semaine en cours

nours955i

XLDnaute Nouveau
Bonjour à tous
je vous sollicite sur un sujet que je maîtrise peu à savoir la création de macro
J'utilise un tableau pour suivre le planning de mes projets (Gantt)
Je vous joins une capture d'écran de mon tableau (je ne peux malheureusement pas vous adresser le fichier en respect des clauses de confidentialité de ma société).
Capture Excel.PNG

  • La ligne 5 est celle des dates au format JJ/MM/AA
  • La colonne D est celle des semaines
Objectif :
je souhaite, depuis une macro exécutable depuis un bouton (ex. le bouton Aujourd'hui sur la capture) positionner le tableau sur la date du jour/semaine en cours.
Ainsi, la colonne de la semaine se positionnerai sur la semaine en cours ET la ligne de la semaine en cours remonterait en tête.
J'ai déjà créé une macro (bouton Aujourd'hui) qui positionne le graph sur la colonne de la date en cours (voir code joint).
Mais je souhaite compléter cette macro pour qu'elle positionne aussi la ligne de la semaine en cours en tête des lignes
Si quelqu'un veut bien m'aider sur ce sujet
En vous remerciant par avance
Bonne journée :)

VB:
Sub Today()
Dim FindString As Date
Dim Rng As Range
FindString = CLng(Date)
With Rows("5:5")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else

'Give a message that todays date was not found

MsgBox "Cette macro positionne le Gantt ˆ la date du jour. La date du jour n'a pas ŽtŽ trouvŽe"
End If
End With

End Sub
 

Eric 45

XLDnaute Occasionnel
Bonjour

Tu peux essayer ceci :
Code:
Sub madate()      'TrouveDateMin_moi()
    Dim plage As Range, Ref#, R&, DateMin As Date
      On Error Resume Next
      With Feuil1
        'on assume que la plage est triée en ordre croissant
        Set plage_H = .Range("dates_H") ' nommer plage cellules dates horizontales
        Set plage_V = .Range("dates_V") ' nommer plage cellules dates verticales
        Ref = .Range("D4")
        R = WorksheetFunction.Match(Ref, plage_V, 1)
        If R > 0 Then If plage_V(R) <> Range("D4") Then If R > 0 Then R = R + 1
        plage_H(R).Offset(1, 0).Select
        ActiveWindow.ScrollColumn = ActiveCell.Column
        macol = ActiveCell.Column
        plage_V(R).Select
        ActiveWindow.ScrollRow = ActiveCell.Row
        ActiveWindow.ScrollColumn = macol
      End With
    End Sub


si j'ai bien compris.
Les cellules des semaines horizontales sont fusionnées ?

A te lire
Eric
 

nours955i

XLDnaute Nouveau
Bonjour

Tu peux essayer ceci :
Code:
Sub madate()      'TrouveDateMin_moi()
    Dim plage As Range, Ref#, R&, DateMin As Date
      On Error Resume Next
      With Feuil1
        'on assume que la plage est triée en ordre croissant
        Set plage_H = .Range("dates_H") ' nommer plage cellules dates horizontales
        Set plage_V = .Range("dates_V") ' nommer plage cellules dates verticales
        Ref = .Range("D4")
        R = WorksheetFunction.Match(Ref, plage_V, 1)
        If R > 0 Then If plage_V(R) <> Range("D4") Then If R > 0 Then R = R + 1
        plage_H(R).Offset(1, 0).Select
        ActiveWindow.ScrollColumn = ActiveCell.Column
        macol = ActiveCell.Column
        plage_V(R).Select
        ActiveWindow.ScrollRow = ActiveCell.Row
        ActiveWindow.ScrollColumn = macol
      End With
    End Sub


si j'ai bien compris.
Les cellules des semaines horizontales sont fusionnées ?

A te lire
Eric

Merci beaucoup Eric... j'aurais jamais pu l'inventer cette macro :)
Toutefois, oui je sais je suis gourmand en ces périodes de fêtes, la colonne de référence (E) à savoir les dates n'est pas celle que je veux chécker mais plutôt une colonne avec les semaines (en effet je n'ai pas une suite continue de date en colonne ni même de semaine)
En somme je voudrais contrôler les dates en lignes (suite continue) avec date du jour comme vous le faites avec les numéros de semaines en colonne (pas forcément continue car je peux avoir des semaines sans projets)
Je ne sais pas si j'ai été très clair o_O
 

Eric 45

XLDnaute Occasionnel
Re

Si j'ai bien compris tu as :

En ligne 5 toutes les dates du 1/1 au 31/12
En ligne 6 toutes les semaines 1 à 52/53

En colonne D tu as les semaines avec des manques, exemple : 1-2-4-5-9-10.....

Question :

Si nous avons une date qui est dans la semaine 3, que veux tu avoir comme ligne : la semaine 2 ou la 4 ?

Eric
 

nours955i

XLDnaute Nouveau
Re

Si j'ai bien compris tu as :

En ligne 5 toutes les dates du 1/1 au 31/12
En ligne 6 toutes les semaines 1 à 52/53

En colonne D tu as les semaines avec des manques, exemple : 1-2-4-5-9-10.....

Question :

Si nous avons une date qui est dans la semaine 3, que veux tu avoir comme ligne : la semaine 2 ou la 4 ?

Eric
Bonsoir Eric
j'ai mis à jour ton fichier Excel en pièce attachée version 2
Comme tu le vois j'ai des tâches discontinues en date et aussi en semaine.
L'objectif est de rechercher la date du jour en ligne 5 comme tu l'as fait sur ta macro (série continue) et la semaine en cours (colonne D)
Toutefois, il est possible que je n'ai aucune tâche sur 1 semaine : exemple je n'ai rien en S1 2018
L'idée serait donc de chercher et d'afficher la ligne à la Semaine inférieure : si S1 absente alors afficher la semaine précédente
Merci pour ton attention
 

Pièces jointes

  • nours955_Positionner_un _tableau_ a_la_date_du_jour V2.xlsm
    20.9 KB · Affichages: 44

Eric 45

XLDnaute Occasionnel
Bonjour à Toutes et Tous

Tu peux essayer ceci :
Code:
Option Explicit
  
    Sub madate()
    Dim plage As Range, Ref#, R&, malign As Integer, plage_H As Range, plage_V As Range

      With Feuil1
        'on assume que la plage est triée en ordre croissant
        Set plage_H = .Range("dates_H") ' nommer plage cellules dates horizontales
        Set plage_V = .Range("dates_V") ' nommer plage cellules dates verticales
        Ref = .Range("D4")     ' date du jour
        R = WorksheetFunction.Match(Ref, plage_V, 1)
        plage_V(R).Select
        malign = ActiveCell.Row
        plage_H(R).Offset(1, 0).Select
        ActiveWindow.ScrollColumn = ActiveCell.Column
        ActiveWindow.ScrollRow = malign
      End With
    End Sub

Eric
 

nours955i

XLDnaute Nouveau
Merci Rouge pour cette proposition matinale d'autant que ça marche :):)
Je vais tester différents scenarii en jouant sur les dates mais ça me semble déjà top
Bonne matinée
Bonjour
après quelques tests et intégration de ta macro... le résultat est à moitié atteint alors que sur ta feuille c'est 100% !!!
En effet :
  • le positionnement à la date se fait bien mais pas à la semaine
  • je n'ai pas le message "la semaine 53 n'a pas été trouvée... positionne à la S51"
A l'occasion si tu veux bien jeter un oeil sur mon fichier
Merci et très bonnes fêtes de fin d'année à tous :)
 

Pièces jointes

  • 2018Planning Test Forum T1.0.xlsm
    306.6 KB · Affichages: 38
Dernière édition:

Discussions similaires