XL 2016 Ouverture des feuilles sur la colonne de la date du jour

[nelson29]

Bonjour,
je recherche un code pour ouvrir des feuilles et que la sélection se positionne sur la date du jour (ou si possible sur le mois concerné😁, mais le jour fera l'affaire). dans mon fichier il y aura plusieurs feuilles (une vingtaine).
Je mets un exemple de mon fichier.
Merci

 

[xUpsilon]

Bonjour,

Quelque chose comme ça ?

Const nLigDates As Integer = 6
Const sPremCol As String = "E"

Private Sub Worksheet_Activate()
nDerCol = Cells(nLigDates, Columns.Count).End(xlToLeft).Column
For nCol = Asc(sPremCol) - 64 To nDerCol
    If Cells(nLigDates, nCol) = DateSerial(Year(Now), Month(Now), Day(Now)) Then
        Cells(nLigDates, nCol).Select
        Exit Sub
    End If
Next nCol
End Sub

Bonne journée,

 

[Cousinhub]

Bonjour,
Une variante.
Dans le ThisWorkbook, tu mets ceci :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If IsDate(Sh.[E6]) And Year(Sh.[E6]) = Year(Date) Then
    Call Goto_Date
End If
End Sub

Et dans un module standard, tu mets ce code :

Sub Goto_Date()
Dim Col As Long
Col = Application.Match(CLng(Date), Rows(6), 0)
Application.Goto Cells(6, Col), True
End Sub

Bonne journée

 

[nelson29]

re bonjour,
Merci pour le retour
pour le premier code rien ne se passe !!, pour le deuxième (celui de bhbh) j'ai une erreur de compilation (fichier erreur en PJ)
Cdlt

 

[Cousinhub]

Re-,
Tu as bien mis le deuxième code fourni dans un module standard?

 

[nelson29]

Effectivement j'avais dû faire une fausse manipulation tous fonctionne parfaitement, juste une petit précision est il possible se positionner sur la cellule du 1er du mois concerné
Cdlt

 

[Cousinhub]

Re-,
En modifiant ainsi?

Sub Goto_Date()
Dim Col As Long, X As Long
X = Date + 1 - Day(Date)
Col = Application.Match(X, Rows(6), 0)
Application.Goto Cells(6, Col), True
End Sub

 

[nelson29]

Super un grand merci
Bonne journée

 

[sder]

Bonjour,

Pourriez vous partager un fichier qui s ouvre sur la date du jour ?

Ce sujet est pas facile pour les débutants comme moi.

Avec un fichier "modèle" qui marche...cela permettra aussi de comprendre comme l'adapter à notre problématique.

Je mets en PJ un lien google sheet (de mon fichier) et aussi en PJ.

Essai d'agenda qui doit s'ouvrir sur la date du jour Merci de votre aide

Jour par Jour Date,Durée en Heure (approximatif),Tâches effectués par Jules,Projet demain (très court),Commentaire de Stéphane,Remarque de Jules suite à mes commentaires (si nécessaire) lundi 12 septembre 2022 mardi 13 septembre 2022 mercredi 14 septembre 2022 jeudi 15 septembre 2022 vendredi ...

docs.google.com

 

[nelson29]

Bonjour,
je reviens sur le sujet pour un problème "code erreur". le code si dessous fonctionne parfaitement, mais j'ai un fichier avec plusieurs onglets qui comporte des plannings avec des dates de commencement différentes. Onglet 01 de janvier à fin Mars, onglet 02 Fin février à début juin, ect....
Le problème est que lorsque j'accéde à des onglets ou le planning n'est pas sur le mois concerné il y a un code erreur. Exemple on est au mois de Mars si j'ouvre l'onglet 05 qui prends en charge début juin jusqu'à septembre il bloque "erreur d'exécution 13" ==> débogage, peut on trouver une solution pour que si la date n'est pas trouvée il ne se met pas en erreur.
le code en question:
Sub Goto_Date()
Dim Col As Long
Col = Application.Match(CLng(Date) - 1, Rows(4), 0)
Application.Goto Cells(4, Col), True
End Sub

Merci

 

[Cousinhub]

Bonjour,
Non testé, mais essaie en rajoutant :

Sub Goto_Date()
Dim Col As Long
Col = Application.Match(CLng(Date) - 1, Rows(4), 0)
If Not IsError(Col) Then Application.Goto Cells(4, Col), True
End Sub

Bonne apm

 

[nelson29]

Bonjour,
Non testé, mais essaie en rajoutant :

Sub Goto_Date()
Dim Col As Long
Col = Application.Match(CLng(Date) - 1, Rows(4), 0)
If Not IsError(Col) Then Application.Goto Cells(4, Col), True
End Sub

Bonne apm

Bonjour bhbh, merci pour la rapidité -🙂 mais le code reste toujours en erreur je mets le fichier en PJ
Cdlt

 

[Cousinhub]

Re-,
Enlève juste le "As Long" après Dim Col

 

[nelson29]

Génial merci ça fonctionne Bonne fin d'après midi et bon WK end