Transformer nombre décimal en hh:mn en vba

[fenec]

Bonjour le forum

Une fois de plus besoin de votre aide car je ne parviens pas à modifier mon code pour l'appliquer à une plage de cellule.
Comptant sur votre savoir je vous joint un fichier qui reprend ma problématique.
Cordialement,
Philippe.

 

[job75]

Bonjour le fil, le forum,

Voyez le fichier joint et cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, sep$, t
Set r = [B5:C35] 'cette plage doit être au format Texte
Set r = Intersect(Target, r)
If r Is Nothing Then Exit Sub
sep = Mid(0.1, 2, 1) 'séparateur décimal de l'ordinateur
Application.EnableEvents = False
On Error Resume Next 'sécurité
For Each r In r 'si entrées/effacements multiples
  t = Replace(Replace(r, ".", sep), ":", sep)
  t = Replace(Format(t, "00.00"), sep, ":")
  r = IIf(IsDate(t), t, "")
Next
If Target.Count = 1 Then If Target = "" Then Target.Select
Application.EnableEvents = True
End Sub

La plage B5:C35 doit être au format Texte.

Bonne journée.

 

[david84]

Bonjour à tous,

La plage B5:C35 doit être au format Texte

je n'ai pas suivi tout le fil mais pourquoi ne pas simplement le faire dans la procédure ?

r.NumberFormat = "@"

D'autre part a priori on peut se passer du test pour trouver le séparateur décimal :
sep = Application.International(xlDecimalSeparator)

A+

 

[job75]

Bonjour David,

je n'ai pas suivi tout le fil mais pourquoi ne pas simplement le faire dans la procédure ?

r.NumberFormat = "@"

Non car si au départ la plage est au format Standard l'entrée d'une heure avec 2 points donnera un nombre décimal avant que la macro ne se déclenche.

A+

 

[david84]

Ok.
Je pense que tu peux éventuellement gérer cela dans l'événement Worksheet_SelectionChange
du type

If Not Intersect(Target, r) Is Nothing Then Target.NumberFormat = "@"

mais cela fait un événement de plus à gérer.
A+

 

[job75]

Re,

Avec la macro précédente on pouvait parfois entrer des secondes, par exemple 18:15:30.

Pour les éviter utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, sep$, t$, pos1%, pos2%
Set r = [B5:C35] 'cette plage doit être au format Texte
Set r = Intersect(Target, r)
If r Is Nothing Then Exit Sub
sep = Mid(0.1, 2, 1) 'séparateur décimal de l'ordinateur
Application.EnableEvents = False
On Error Resume Next 'sécurité
For Each r In r 'si entrées/effacements multiples
  t = Replace(Replace(Replace(r, ".", sep), ",", sep), ":", sep)
  pos1 = InStr(t, sep) 'position du 1er séparateur
  pos2 = InStr(pos1 + 1, t, sep) 'position du 2ème séparateur
  If pos2 > pos1 Then t = Left(t, pos2 - 1)
  t = Replace(Format(t, "00.00"), sep, ":")
  r = IIf(IsDate(t), t, "")
Next
If Target.Count = 1 Then If Target = "" Then Target.Select
Application.EnableEvents = True
End Sub

Fichier (2), voyez aussi la Workbook_Open dans ThisWorkbook.

J'ai mis une liste de validation en C1, c'est quand même plus propre.

Edit pour David : si l'on craint que l'utilisateur modifie le format Texte ou les formules, protéger la feuille après avoir déverrouillé toutes les cellules puis verrouillé les plages A5:A35 et D5: D35.

A+

 

[fenec]

Bonjour le forum, phlaurent55, Roland_M, JCGL, Job75, Regueiro

phlaurent55
Merci pour ton aide, je pense que Job75 à répondu à ton soucis.

Roland_M
Ton code corresponds à mon attente sauf que si je tape 7.3 il m’écrit 7 :3 mais pas 7 :30 et pour être franc ton code je ne le comprends pas avec tes $, @, %.

JCGL
J’ai testé ta solution mais le problème reviens au code de phlaurent55 si je tape 7.30 ca me met 7.12.

Job75
Comme toujours ca fonctionne.
Bien vu la liste déroulante c’est vrai que c’est plus propre je ne sais pas pourquoi j’ai mis un format de contrôle d’ailleurs. Je me complique la vie parfois.

Regueiro
Une autre façon de faire, encore plus paresseux que l’âne même pas un point à taper LOL.

Un grand merci à vous tous, bonne soirée.
Cordialement,
Philippe.

 

[Roland_M]

re

tu dis: pour être franc ton code je ne le comprends pas avec tes $, @, %.

c'est pourtant simplissime !

A$ est idem à Dim A As String
A% est idem à Dim A As Integer
@ c'est une valeur currency

il y a encore d'autres, un peu de recherche te renseignerait

quand au 7:30 il est facile de modifier le format !

voir ceci:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5:C35")) Is Nothing Then
   Application.EnableEvents = False
   R$ = Replace(Target, ",", ".")
   V@ = Val(R$)
   H% = Int(V)
   M$ = Str(V - H): M$ = Trim(Replace(M$, ".", ""))
   If Len(M$) < 2 Then M$ = M$ & "0"
   Target = Str(H) & ":" & M$
   Application.EnableEvents = True
End If
End Sub

 

[JCGL]

Bonjour à tous,

JCGL
J’ai testé ta solution mais le problème reviens au code de phlaurent55 si je tape 7.30 ca me met 7.12.

Si tu as appliqué la correction automatique requise en tapant 7**30 tu auras 7:30....

A+ à tous

 

[fenec]

Bonjour le forum,
Avançant dans ma feuille de pointage, je reviens vers vous car je rencontre un problème avec mes heures de nuit.
je ne comprends pas pourquoi elles ne se comptabilisent plus, du coup mes heures de jours sont fauusent.
Vous seriez gentil pour m'aider sur ce point
Vous joint un fichier de ou j'en suis.
Cordialement ,
Philippe.

 

[Roland_M]

Bonjour,

c'est normal tes cellules ne sont pas au bon format pour qu'Excel puissent effectuer un calcul temps !
tu as même des format texte alors ... rien ne va plus !

essaies ceci en format personnalisé dans toutes tes cellules horaires et verras apparaître les résultats !
[h] : mm