Ouvrir excel sur la date du jour

• Vous pouvez mettre en forme votre code grâce à la flèche en haut a droite de l'éditeur de texte.

Sub NumSemJour()
Dim DateTest, Semaine
DateTest = DateValue(Now)
Semaine = Format(DateTest, "ww", vbMonday, vbFirstFourDays)
Sheets(Semaine).Select
   If IsError(Application.Match(Val(CDbl(Now)), Columns(1), 0)) Then
      MsgBox "Date non trouvée ?"
     Else
      Application.Goto Range("A" & Application.Match(Val(CDbl(Now)), Columns(1), 0)), True
   End If
End Sub

Sub NumSemJour()
Dim DateTest, Semaine, Nlig
DateTest = DateValue(Now)
Semaine = Format(DateTest, "ww", vbMonday, vbFirstFourDays)
On Error GoTo Fin
   Sheets(Semaine).Select
   Nlig = 1 ' numero de Ligne
      If IsError(Application.Match(Val(CDbl(Now)), Rows(Nlig), 0)) Then
            MsgBox "Date non trouvée ?", vbCritical
        Else
            Application.Goto Cells(Nlig, Application.Match(Val(CDbl(Now)), Rows(1), 0)), True
      End If
   Exit Sub
Fin:
   Select Case Err.Number
      Case 9
          MsgBox "Impossible de trouver la feuille à afficher.", vbCritical
   End Select
End Sub

Sub NumSemJour()
Dim DateTest, Semaine, Nlig
DateTest = DateValue(Now)
Semaine = Format(DateTest, "ww", vbMonday, vbFirstFourDays)
On Error GoTo Fin
   Sheets(" " & Semaine).Select
   Nlig = 19 ' numero de Ligne
      If IsError(Application.Match(Val(CDbl(Now)), Rows(Nlig), 0)) Then
            MsgBox "Date non trouvée ?", vbCritical
        Else
            Application.Goto Cells(Nlig, Application.Match(Val(CDbl(Now)), Rows(Nlig), 0)), True
      End If
   Exit Sub
Fin:
   Select Case Err.Number
      Case 9
          MsgBox "Impossible de trouver la feuille à afficher.", vbCritical
   End Select
End Sub

Sub test()
Dim NumSem As Byte
Dim i As Integer
On Error Resume Next
Sheets(DatePart("ww", Date, 0, 0) + 1).Activate
Do
Cells(19, i + 1).Activate
If Cells(19, i + 1) = Date Then
ActiveWindow.ScrollRow = i + 1
Exit Do
End If
i = i + 1
Loop
End Sub

Sub test()
Dim Plage, Cell As Range
On Error Resume Next
Sheets(DatePart("ww", Date, 0, 0) + 1).Activate
Set Plage = Range("D19:H19")
On Error Resume Next
Sheets(DatePart("ww", Date, 0, 0) + 1).Activate
For Each Cell In Plage
If Cell.Value = Date Then Cell.Select
Next
End Sub

Private Sub Workbook_Open()
Call test
End Sub

Sub test()
Dim Plage, x, Cell As Range
On Error Resume Next
Sheets(DatePart("ww", Date, 0, 0) + 1).Activate ' ---------- sélectionne l'onglet correspondant au numéro semaine de la date courante
Set Plage = Range("D19:H19") ' ----------------------------- plage contenant les dates dans tous les onglets
On Error Resume Next
' ------------------------------------- boucle sur tous les onglets
For x = 1 To Worksheets.Count
Sheets(x).Range("D19:H19").Interior.ColorIndex = 6 ' -- rétabli la couleur jaune sur la plage des dates
Sheets(x).Tab.Color = RGB(226, 226, 226) ' ------------ rétabli la couleur système des onglets
Next
 ActiveSheet.Tab.ColorIndex = 3 ' ------------- colorise l'onglet actif correspondant au n° semaine en cours
 ' -------------------------------------------- boucle sur la plage pour sélectionner la cellule de la date en cours
For Each Cell In Plage
If Cell.Value = Date Then Cell.Interior.ColorIndex = 4
Next
End Sub 

Private Sub Workbook_Open()
Call test
End Sub