Ouvrir un fichier Excel (planning) direct sur la date d'aujourdhui

Bonjour

Dans la configuration actuelle : dates en ligne 1

Module du classeur : à l'ouverture du classeur se positionne en ligne 3 sous la date du jour

Private Sub Workbook_Open()
    With Worksheets("RACIS_Planning")
        Set Plage = .Range("1:1")
        For i = 1 To 1000
            Adr = Plage(1, i).End(xlToRight).Address
            If IsDate(.Range(Adr)) Then
                .Activate
                .Range(Adr).Offset(2, (Date - .Range(Adr)) * 2).Select
                Exit For
            End If
        Next i
    End With
End Sub

bonjour Chris78,

merci ! ça fonctionne, sauf que j'arrive sur le samedi 4 octobre ...et pas la date du jour....c'est pas gênant en soi ...

image

mais crois tu pouvoir adapter le code stp pour que la cellule sélectionnée soit située 23 colonnes avant : comme ci après (pour que ça soit plus " sympa" comme présentation) :

image

d'avance merci pour ton retour et ton aide précieuse !!

Re

Bizarre sur ton fichier posté en MP j’atterris bien en VY3 sous le 6 octobre. N'aurais-tu pas

  • une date dans une des cellules A1, B1, C1, D1 ou E1 ?
  • une 1ère date autre que le 01/01/2025 ?

bonjour le fil, salut 78Chris,

une autre méthode

Private Sub Workbook_Open()
     Dim r
     With Worksheets("RACIS_Planning")
          r = Application.IfError(Application.Match(CLng(Date), .Rows(1), 1), 0)     'trouver la colonne avec la date d'aujourd'hui ou plus petite, si introuvable = 0
          r = Application.Max(10, r - 12)    'on veut 12 colonnes vers gauche, mais par exemple min colonne 10
          Application.Goto .Cells(1, r), 1   'se déplacer vers cette cellule
     End With
End Sub

RE

une autre méthode

Private Sub Workbook_Open()
     Dim r
     With Worksheets("RACIS_Planning")
          r = Application.IfError(Application.Match(CLng(Date), .Rows(1), 1), 0)     'trouver la colonne avec la date d'aujourd'hui ou plus petite, si introuvable = 0
          r = Application.Max(10, r - 12)    'on veut 12 colonnes vers gauche, mais par exemple min colonne 10
          Application.Goto .Cells(1, r), 1   'se déplacer vers cette cellule
     End With
End Sub

Arf j'ai cherché avec Application.Match mais sans CLng cela ne marchait pas... d'où le détour...

Bonsoir,

une autre version :

Private Sub Workbook_Open()
    Dim Cel As Range
    Set Cel = Sheets("Feuil1").Range("1:1").Find(Format(Date, "DDDD D MMMM YYYY"), LookIn:=xlValues)
    If Not Cel Is Nothing Then Cel.Activate
End Sub

avec le fichier exemple à adapter :

@ bientôt

LouReeD

Bonjour

une autre version :

Private Sub Workbook_Open()
    Dim Cel As Range
    Set Cel = Sheets("Feuil1").Range("1:1").Find(Format(Date, "DDDD D MMMM YYYY"), LookIn:=xlValues)
    If Not Cel Is Nothing Then Cel.Activate
End Sub

Celle-ci c'est la 1ère que nous avons tenté mais elle ne fonctionne pas sur le fichier de Sabdébutante...

bonjour 78chris

suite à ton dernier retour, pour te répondre :

je ne vois pas date en A1, B1, C1, D1, E1 et pas d'autre date indiquée à part à partir du 01.01.2025....

et aujourd’hui j’atterris sur la date du 06.10...et toujours tout à droite de la feuille ...

plus possible de t' envoyer le fichier MP... il est trop lourd.

RE

Essaye la méthode de BsAlv qui cherche directement la date du jour

Il ne te manque pas 1 ou 2 dates ? Si c'est le cas le problème doit être le même avec l'hyperlien...

bonjour, je confirme j'ai le m^me souci avec le code d' BsAlv, j'arrive su rl 06/10 et j'ai vérifiée je ne vois pas de dates manquantes ...

re,

pouvez-vous télécharger votre fichier, uniquement la ligne 1 (le reste est sans importance, donc éventuellement supprimer)

Salut Sab,
Salut les as,

Dans ThisWorkbook, évidemment, en corrigeant le nom de la feuille (CAL), le cas échéant.

Private Sub Workbook_Open()
'
Dim iDif%
With Worksheets("CAL")
    iDif = DateDiff("d", CDate(.Range("JM3").Value), Date)
    ActiveWindow.ScrollColumn = Range("JM3").Column + (iDif * 2)
End With
'
End Sub
8sab.xlsm (93.77 Ko)

A+

Correction..

Private Sub Workbook_Open()
'
Worksheets("CAL").Activate
ActiveWindow.ScrollColumn = Range("JM3").Column + (DateDiff("d", CDate(Range("JM3").Value), Date) * 2)
'
End Sub
15sab.xlsm (93.78 Ko)

A+

Rechercher des sujets similaires à "ouvrir fichier planning direct date aujourdhui"