Autres Peut-on supprimer les secondes dans la barre des tâches?

[un internaute]

Bonjour le forum
J'ai gratté pas mal mais trouvé qu'aller gratter dans base de registre pas top!!!
Windows 7 et Excel 2003
Pour éviter de modifier les macros j'ai fait une barre verticale dessin pour partager la colonne E6:E36 en 2
Et je tape mes heures de RV (quand il y en a 2) mais les secondes s'affichent dans la barre des tâche
Je suis obligé chaque fois des les supprimer et de faire 3 tab ou plus (pour centrer) et taper l’autre heure

Barre des tâches

Merci pou éventuels retours

 

[un internaute]

Bonjour à tous
Toutes mes excuses pour le retard mais la maladie est là (CHU)
J'ai pensé à modifier ma macro comme ci-dessous et ça fonctionne mais il y a un "petit" mais
Si je tape 10:20 dans la barre des formules et NON des tâches un espace 15:40 par exemple ça va (centrage bon) mais si je tape 8:30 15:40 il y a un petit décalage
Alors l'astuce c'est de taper 08:30
Mais un AS du VBA doit trouver une condition mais laquelle?
Merci pour vos éventuels retours
Cordialement

PS: toutes mes excuses de ne pouvoir joindre un fichier

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim LaDate As Date
Dim MoisSuivant As String

  If Target.Count > 1 Or Sh.Name = "MENU" Then Exit Sub
 
  If Not Intersect(Sh.Range("I1"), Target) Is Nothing Then
    Inscription_Motifs
  Else
    Application.EnableEvents = False
    NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)                               ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
    LaDate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)  '  Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
   
    If Target.Row - 5 > Day(Date) And Target.Column < 5 Then
      Beep
      MsgBox "PAS LE BON JOUR"
      Target = ""
    Else
      If Target.Column = 5 And Target.Row > 5 Then
        If Target <> "" Then
          Range("D" & Target.Row) = Application.Proper(Format(LaDate, "dddd dd mmmm yyyy"))
            Application.EnableEvents = False
          If Len(Target) > 5 Then
          Target = Left(Target, 5) & "    " & Right(Target, 5)          'Mid(Target, 5)
        End If
        Application.EnableEvents = True

        Else
          Range("D" & Target.Row).Resize(, 4).ClearContents
          If Range("A" & Target.Row) = "" Then Range("H" & Target.Row) = ""
        End If
      End If
     
      If Not Intersect(Sh.Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then       ' Surveille la plage du 1er au dernier jours du mois
        ' Si la colonne B et la colonne C est vide on efface la date
        Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Application.Proper(Format(LaDate, "dddd dd mmmm yyyy")))
        If Range("A" & Target.Row) <> "" Then
          Range("H" & Target.Row) = LaDate
        Else
          Range("H" & Target.Row) = ""
        End If
      End If
    End If
  End If
  Application.EnableEvents = True
End Sub

 

[un internaute]

Bonjour le forum
Voilà
Bon WE à tous

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer, Pos_Esp
Dim LaDate As Date
Dim MoisSuivant As String

  If Target.Count > 1 Or Sh.Name = "MENU" Then Exit Sub
 
  If Not Intersect(Sh.Range("I1"), Target) Is Nothing Then
    Inscription_Motifs
  Else
    Application.EnableEvents = False
    NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
    LaDate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
    
    If Target.Row - 5 > Day(Date) And Target.Column < 5 Then
      Beep
      MsgBox "PAS LE BON JOUR"
      Target = ""
    Else
If Target.Column = 5 And Target.Row > 5 Then
            If Target <> "" Then
                Range("D" & Target.Row) = Application.Proper(Format(LaDate, "dddd dd mmmm yyyy"))
                'Mise en forme des horaires doubles
                Pos_Esp = InStr(1, Target, " ", 1) 'Recherche du caractère "Espace"
                If Pos_Esp <> 0 Then               ' Présence de 2 horaires
                    If Pos_Esp = 5 Then
                        Target = Left(Target, Pos_Esp - 1) & "    " & Mid(Target, Pos_Esp + 1, 5)
                    ElseIf Pos_Esp = 6 Then   '6 ou 5
                        Target = Left(Target, Pos_Esp - 1) & "   " & Mid(Target, Pos_Esp + 1, 5)
                    End If
                End If
            Else
            Application.EnableEvents = False
          If Len(Target) > 5 Then
          Target = Left(Target, 4) & "    " & Right(Target, 4)          'Mid(Target, 5)
        End If
        Application.EnableEvents = True

          Range("D" & Target.Row).Resize(, 4).ClearContents
          If Range("A" & Target.Row) = "" Then Range("H" & Target.Row) = ""
        End If
      End If
      
      If Not Intersect(Sh.Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then       ' Surveille la plage du 1er au dernier jours du mois
        ' Si la colonne B et la colonne C est vide on efface la date
        Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Application.Proper(Format(LaDate, "dddd dd mmmm yyyy")))
        If Range("A" & Target.Row) <> "" Then
          Range("H" & Target.Row) = LaDate
        Else
          Range("H" & Target.Row) = ""
        End If
      End If
    End If
  End If
  Application.EnableEvents = True
End Sub