Ligne curseur qui se déplace automatiquement en fonction de la date/semaine

Bonjour

J'ai inséré ce code dans un module.

Set re = Rows(26).Find(Application.WorksheetFunction.WeekNum(Date))    'on recherche la cellule qui contient le numero de semaine de la date du jour
    If Not re Is Nothing Then 'si on a trouvé le numéro de semaine
    re.Select 'on selectionne la cellule
    With ActiveSheet.Shapes("connecteur droit 2") ' on prend le trait
        .Top = re.Top    ' on aligne la partie supérieure du trait avec la partie supérieure de la cellule
        .Left = re.Left + re.Width - 5  'on positionne le trait verticalement avec un décalage de 5 par rapport au bord droit de la cellule
    End With
    End If

A l'ouverture du classeur, le curseur devra se positionner sur la date/semaine/mois automatiquement.

Pour le moment, je n'arrive pas a trouver la solution, pouvez-vous m'aider ?

a+

Bonjour ,

C'est normal "Sub Workbook_Open()" est une procedure a mettre dans ThisWorkbook et pas dans un module.

Ensuite aujourd'hui nous sommes en semaine 40 et il n'y a pas de 40 sur ta ligne 26

Je doute meme qu'en ligne 26 soit inscrit les semaines, je dirais que c'est plutot les lundi de chaque mois
C'est ta ligne 25 les semaines

A+

Bonjour,

Merci pour ta réponse.

J'ai mis le code dans le workbook.

Oui un déplacement le lundi de chaque semaine, ligne 26.

Donc j'ai fait cela:

Private Sub Workbook_Open()
Set re = Rows(26).Find(Application.WorksheetFunction.WeekNum(Date))    'on recherche la cellule qui contient le numero de semaine de la date du jour
    If Not re Is Nothing Then 'si on a trouvé le numéro de semaine
    re.Select 'on selectionne la cellule
    With ActiveSheet.Shapes("connecteur droit 2") ' on prend le trait
        .Top = re.Top    ' on aligne la partie supérieure du trait avec la partie supérieure de la cellule
        .Left = re.Left + re.Width - 5  'on positionne le trait verticalement avec un décalage de 5 par rapport au bord droit de la cellule
    End With
    End If
End Sub

Que faut il mettre a la place de date ou autre dans le code afin qu'il prenne en compte les lundis de chaque semaine ? le curseur se déplacerait au lundi 02/10/2023

En vous remerciant,

a+

Moi je ne changerais pas la macro mais ton fichier.

En ligne 26, il faut mettre les numero de semaines car tes données ne sont pas exploitable entre les colonnes rajouté comme la AA, les fusions de cellule et le faite qu'il n'y ai pas de formules pour passer d'un jour a un autre.

Tu devrais peut etre meme refaire le fichier en te servant comme base des modeles de gantt

Oui je comprends.

C'est juste un fichier temporaire.

Mais est il possible avec ce fichier, de trouver le code qui va venir placer le curseur sur le lundi de la semaine en cours ?

J'ai essaye avec weekday, j'arrive a faire déplacer le curseur mais pas sur le bon lundi de la semaine en cours.

Pouvez-vous m'aider ?

Ce n'est pas que je ne veux pas te donner de solution mais dans ta ligne 26 il n'y a pas de jour.
C'est seulement un nombre donc comment définir quel colonne choisir si le lundi tombe un 18 ? La colonne X ou la AL ?

C'est pour ça que je te conseil de prendre un modele

En gros, pour moi je ne pense pas que ce soit possible ou trop compliqué pour "de la bricole"

Oui. Je vous remercie en tout cas.

Bonne journee

Tu peux faire en V26 : 04/09/2023

en W26 : =V26+7 tu etire jusqu'a la derniere colonne

Tu copie colle en valeur puis change le format en JJ

Regarde bien que ta date soit 04 / 11 /18 / 25 .....

Mais la formule a l'interieur

Sub Workbook_Open()
LundiSem = Date - Weekday(Date, vbMonday) + 1
Set re = Rows(26).Find(LundiSem)
'on recherche la cellule qui contient le lundi de la semaine en cours
    If Not re Is Nothing Then 'si on a trouvé le numéro de semaine
    re.Select 'on selectionne la cellule
    With ActiveSheet.Shapes("connecteur droit 2") ' on prend le trait
        .Top = re.Top    ' on aligne la partie supérieure du trait avec la partie supérieure de la cellule
        .Left = re.Left + re.Width - 5  'on positionne le trait verticalement avec un décalage de 5 par rapport au bord droit de la cellule
    End With
    End If
End Sub

Avec ça, tu pense avoir le bon resultat mais tes colonnes en trop comme la AA vont juste ne plus correspondre aux mois / annee au dessus et tes donnée en dessous vont etre fausses également.

bonjour,

une solution pour un problème à éviter, ma macro aujourdhui (+Workbook open)

Sub Aujourdhui()
     Dim Lundi, c1 As Range, c2 As Range, c3 As Range

     Lundi = Date - WorksheetFunction.Weekday(Date, 2) + 1     'le lundi de cette semaine
     With Sheets("current")
          Set c1 = .Rows(24).Find(Year(Lundi))     'rechercher l'année
          If Not c1 Is Nothing Then
               i = c1.MergeArea.Cells.Count  'nombre de cellules dans cette cellule fusionnée
               Set c2 = c1.Offset(1).Resize(, i).Find(Month(Lundi))     'rechercher le mois
               If Not c2 Is Nothing Then
                    i = c1.MergeArea.Cells.Count     'nombre de cellules dans cette cellule fusionnée
                    Set c3 = c2.Offset(1).Resize(, i).Find(Format(Lundi, "dd"))     'rechercher le jour (du lundi)
                    If Not c3 Is Nothing Then
                         With .Shapes("connecteur droit 2")     ' on prend le trait
                              .Top = c3.Top  ' on aligne la partie supérieure du trait avec la partie supérieure de la cellule
                              .Left = c3.Left + c3.Width - 5     'on positionne le trait verticalement avec un décalage de 5 par rapport au bord droit de la cellule
                              Exit Sub
                         End With
                    End If
               End If
          End If
     End With
     MsgBox "désolé"
End Sub

Pour Geof52,

Quand je passe au format jj, dans chaque cellule j'ai jj et non la date du jour.

J'ai corrige en dd car j'ai Excel en anglais pour un peu compliquer les choses.

a+

J'ai juste merge cellule AA avec cellule AB .

j'ai mis votre code dans le Workbook_open.

mais en effet, il ne se passe rien

a+

Merci a vous deux BsAlv et Geof52.

J'ai la meme chose mais cette fois ci avec des trimestres ou je dois placer le curseur sur le 1er de chaque mois, proportionnel au quarter.

a+

re,

j'avais dit un problème à éviter ...

Sub Aujourdhui()
     Dim Lundi, c1 As Range, c2 As Range, c3 As Range
     With Sheets("sheet1")
          Set c1 = .Rows(15).Find(Year(Lundi))     'rechercher l'année
          If Not c1 Is Nothing Then
               i = c1.MergeArea.Cells.Count  'nombre de cellules dans cette cellule fusionnée
               Set c2 = c1.Offset(1).Resize(, i).Find("Q" & (Month(Date) + 2) \ 3)     'rechercher le quarter
               If Not c2 Is Nothing Then
                    d1 = DateSerial(Year(Date), WorksheetFunction.Floor(Month(Date) - 1, 3) + 1, 1)     'first day of this quarter
                    d2 = WorksheetFunction.EDate(d1, 3)     'first day of next quarter
                    With .Shapes("connecteur droit 2")     ' on prend le trait
                         .Top = c2.Top       ' on aligne la partie supérieure du trait avec la partie supérieure de la cellule
                         .Left = c2.Left + c2.Width * (Date - d1) / (d2 - d1)     'on positionne le trait verticalement avec son pourcentage du quarter
                         Exit Sub
                    End With
               End If
          End If
     End With
     MsgBox "désolé"
End Sub