DoubleClick = Heure système arrondie

Version imprimable

Bonjour,
J'utilise actuellement ceci pour la saisie de l'heure par double click,
Mais je voudrais qu'en plus ça arrondisse l'heure à l'inférieure ou supérieur selon condition

Ex: En colonne B Heure inférieure à 07:30 ...... saisie 07:30
En colonne C Heure supérieure à 12:00 ..... saisie 12:00

Merci à vous de votre aide:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ActiveSheet.Unprotect ("...") Cancel = True Target.Value = Time Target.Interior.ColorIndex = 34 Target.Locked = True ActiveSheet.Protect ("...") For Each w In Application.Workbooks w.Save Next w Application.CommandBars("Ply").Enabled = True Application.Quit End Sub

09/01/2013, 15h32
tedo01

Bonjour,
Quelles doivent être les règles exactes d'arrondi ?
10/01/2013, 16h56
progheure

J'ai mis en place un pointage d'heures par double click qui prend "Time"
Je voudrais que dans la colonne A, au moment du double click, si l'heure système est inférieure à 07:30, ça remplisse en fait 07:30, si supérieur à 07:30 que ca remplisse l'heure réelle système, et que,
Pour la colonne B, si l'heure système au moment du double click est supérieure à 12:00, que ça affiche 12:00 et que ça affiche l'heure réelle système si c'est inférieur.

Bonjour,

remplace

Code:

Target.Value = Time

par

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
'Colonne A : si avant 7:30 on met 7:30
If Target.Column = 1 Then
   If Time < TimeSerial(7,30,0) Then
      Target.Value = TimeSerial(7,30,0)
   Else
      Target.Value = Time
   End If
Else
   'Colonne B : si après 12:00 on met 12:00
   If Target.Column = 2 Then
      If Time > TimeSerial(12,0,0) Then
         Target.Value = TimeSerial(12,0,0)
      Else
         Target.Value = Time
      End If
   'Autres colonnes
   Else
      Target.Value = Time
   End If
End If

J'ai rajouté mes 2 dernières colonnes comme ton code, mais ça ne fonctionne pas avec ce que j'ai rajouté. Si tu trouves la solution je n'ai plus rien à faire et je te dis un grand merci.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect ("...")
    [S]Cancel = True
 
    'Colonne A : si avant 7:30 on met 7:30
If Target.Column = 1 Then
   If Time < TimeSerial(7, 30, 0) Then
      Target.Value = TimeSerial(7, 30, 0)
   Else
      Target.Value = Time
   End If
Else
   'Colonne B : si après 12:00 on met 12:00
   If Target.Column = 2 Then
      If Time > TimeSerial(12, 0, 0) Then
         Target.Value = TimeSerial(12, 0, 0)
      Else
         Target.Value = Time
      End If
Else
   'Colonne C : si avant 13:30 on met 13:30
   If Target.Column = 3 Then
      If Time < TimeSerial(13, 30, 0) Then
         Target.Value = TimeSerial(13, 30, 0)
      Else
         Target.Value = Time
      End If
Else
   'Colonne D : si après 18:00 on met 18:00
   If Target.Column = 4 Then
      If Time > TimeSerial(18, 0, 0) Then
         Target.Value = TimeSerial(18, 0, 0)
      Else
         Target.Value = Time
      End If
   'Autres colonnes
   Else
      Target.Value = Time
   End If
End If
 
    Target.Interior.ColorIndex = 34
    Target.Locked = True
    ActiveSheet.Protect ("...")
For Each w In Application.Workbooks
w.Save
Next w
Application.CommandBars("Ply").Enabled = True
Application.Quit
End Sub

11/01/2013, 11h41
progheure

Je viens de trouver le pourquoi du comment.
Tout fonctionne.
Merci encore.