Petite macro qui me plante Excel sur tous les PC

bonjour,

Je souhaitais ajouter la date et l'heure sur chaque ligne qui avait une valeur supérieur à 0 avec ce code:

Private Sub Worksheet_Calculate()

    'J'applique une date et heure à chaque ligne scannée:

    'Ligne 15

        If Range("i15") > 0 Then
            Range("k15") = Format(Time, "hh:mm;@")
            Range("j15") = Format(Date, "dd/mm/yy")

        Else
            Range("k15") = ""
            Range("j15") = ""

        End If

    'Ligne 16

            If Range("i16") > 0 Then
            Range("k16") = Format(Time, "hh:mm;@")
            Range("j16") = Format(Date, "dd/mm/yy")

        Else
            Range("k16") = ""
            Range("j16") = ""

        End If

    'Ligne 17

            If Range("i17") > 0 Then
            Range("k17") = Format(Time, "hh:mm;@")
            Range("j17") = Format(Date, "dd/mm/yy")

        Else
            Range("k17") = ""
            Range("j17") = ""

        End If

    'Ligne 18

            If Range("i18") > 0 Then
            Range("k18") = Format(Time, "hh:mm;@")
            Range("j18") = Format(Date, "dd/mm/yy")

        Else
            Range("k18") = ""
            Range("j18") = ""

        End If

    'Ligne 19

            If Range("i19") > 0 Then
            Range("k19") = Format(Time, "hh:mm;@")
            Range("j19") = Format(Date, "dd/mm/yy")

        Else
            Range("k19") = ""
            Range("j19") = ""

        End If

    'Ligne 20

            If Range("i20") > 0 Then
            Range("k20") = Format(Time, "hh:mm;@")
            Range("j20") = Format(Date, "dd/mm/yy")

        Else
            Range("k20") = ""
            Range("j20") = ""

        End If

    'Ligne 21

            If Range("i21") > 0 Then
            Range("k21") = Format(Time, "hh:mm;@")
            Range("j21") = Format(Date, "dd/mm/yy")

        Else
            Range("k21") = ""
            Range("j21") = ""

        End If

    'Ligne 22

            If Range("i22") > 0 Then
            Range("k22") = Format(Time, "hh:mm;@")
            Range("j22") = Format(Date, "dd/mm/yy")

        Else
            Range("k22") = ""
            Range("j22") = ""

        End If

    'Ligne 23

            If Range("i23") > 0 Then
            Range("k23") = Format(Time, "hh:mm;@")
            Range("j23") = Format(Date, "dd/mm/yy")

        Else
            Range("k23") = ""
            Range("j23") = ""

        End If

    'Ligne 24

            If Range("i24") > 0 Then
            Range("k24") = Format(Time, "hh:mm;@")
            Range("j24") = Format(Date, "dd/mm/yy")

        Else
            Range("k24") = ""
            Range("j24") = ""

        End If

    'Ligne 25

            If Range("i25") > 0 Then
            Range("k25") = Format(Time, "hh:mm;@")
            Range("j25") = Format(Date, "dd/mm/yy")

        Else
            Range("k25") = ""
            Range("j25") = ""

        End If

End Sub

Ce que je souhaitais faire c'était d'introduire la date et heure à laquelle la ligne a été renseignée. Il faut que cette date et heure soit statique. Impossible donc d'utiliser =maintenant() ou autre formule car celle-ci serait dynamique.

Merci d'avance.

Patrick.

bonjour,

il faut blocquer les events avec application.enableevents=false au début et =true à la fin

La 2ième macro est pour liberer les events en cas de blocage

Private Sub Worksheet_Calculate()

     Application.EnableEvents = False     'blocquer events
     For ligne = 15 To 25     'boucle ces lignes
          If Range("i" & ligne) > 0 Then
               Range("k" & ligne) = Format(Time, "hh:mm;@")
               Range("j" & ligne) = Format(Date, "dd/mm/yy")
          Else
               Range("j" & ligne).Resize(,2).ClearContents
          End If
     Next
     Application.EnableEvents = True

End Sub

Sub Events_On()
     Application.EnableEvents = True
End Sub

Bonjour PatPatrouille, le forum,

Pour l'optimisation, essaie:

Private Sub Worksheet_Calculate()
 Dim i%
  Application.ScreenUpdating = False
    For i = 15 To 25
     Select Case Range("I" & i).Value
      Case Is > 0
       Range("K" & i) = Format(Time, "hh:mm;@")
       Range("J" & i) = Format(Date, "dd/mm/yy")
      Case Else
       Range("K" & i) = ""
       Range("J" & i) = ""
     End Select
    Next i
End Sub

[EDIT] : Salut BsAlv,

Cordialement,

Excellent! Je l'avais mis pour une ligne et après je me suis dit que ce ne serait sûrement pas nécessaire.

Merci.

Re,

Je pense qu'avant End Sub il manque cela dans ton code, non?

Application.ScreenUpdating = True

En parcourant le forum, il semblerait que cela ne soit pas utile , quand les macros sont terminées, Excel rétablit l'actualisation de l'écran à True...mais bon, ça ne mange pas de pain.

Cordialement,

Re BsAlv,

ton code fonctionne bien MAIS il y a un petit soucis:

ça prend toujours la dernière heure (minute) où il y a une modification. Pire, si je ferme le fichier et que je l'ouvre 10 minutes plus tard, ça me change l'heure et l'établi à l'heure où j'ai accédé au fichier (donc, j'imagine que si je l'ouvre demain, la date aussi aura changé).

Je n'arrive donc pas à figer l'heure et la date à laquelle la ligne a été renseignée. Il pourrait y avoir une solution: Copier une cellule contenant la date et l'heure et la copier à la ligne correspondante

Je me demande si ce code fonctionnerait:

Private Sub Worksheet_Calculate()
 Dim i%
  Application.ScreenUpdating = False
    For i = 15 To 25
     Select Case Range("I" & i).Value
      Case Is > 0
       Range("A2").Select 'A2 contient l'heure dynamique qui s'actualise 
        Selection.Copy
        Range("K" & i).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A3").Select 'A3 contient la date
        Selection.Copy
        Range("J" & i).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

 Else
       Range("K" & i) = ""
       Range("J" & i) = ""
     End Select
    Next i
End Sub

MAIS, je pense qu'il faudrait qu'à chaque fois il y ait aussi

'Je demande de faire une actualisation de la cellule A2 :
    Sheets("SCAN").Range("A2").Calculate

Qu'est ce que vous en pensez?

Merci.

Patrick

bonjour PatPatrouille, Xorsankukai,

c'est quoi le but ? Si vous modifiéz une cellule que K&J montrent date & heure, alors il faut utiliser l'event "change" ...

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c     As Range
     Set c = Intersect(Target, Range("I15:I25"))     'seulement les cellules changées de la plage I15:I25)
     If Not c Is Nothing Then
          Application.EnableEvents = False     'blocquer events
          For Each cl In c.Cells     'boucle ces cellules modifiée
               If cl.Value > 0 Then     'non vide
                    cl.Offset(, 2).Value = Format(Time, "hh:mm;@")     '2 cellules vers droite
                    cl.Offset(, 1).Value = Format(Date, "dd/mm/yy")     '1 cellule vers droite
               Else
                    cl.Offset(, 1).Resize(, 2).ClearContents
               End If
          Next
          Application.EnableEvents = True
     End If
End Sub

BsAlv,

le but, comme je l'ai cité, est de faire en sorte d'avoir la date et l'heure statique chaque fois qu'une ligne est renseignée. C'est à dire, dès que la cellule i15 et modifiée, dans j15 la date apparait et dans k15 l'heure apparait. Je ne peux pas faire

=si(i15="";"";maintenant()) 

car la date et l'heure doivent resté statiques. Avec la fonction ci-dessus nous serions en mode dynamique, à chaque ouverture ou modification de la feuille la date et l'heure changeraient.

Cela doit se faire pour les lignes de 15 à 25.

Votre code

Private Sub Worksheet_Calculate()

     Application.EnableEvents = False     'blocquer events
     For ligne = 15 To 25     'boucle ces lignes
          If Range("i" & ligne) > 0 Then
               Range("k" & ligne) = Format(Time, "hh:mm;@")
               Range("j" & ligne) = Format(Date, "dd/mm/yy")
          Else
               Range("j" & ligne).Resize(,2).ClearContents
          End If
     Next
     Application.EnableEvents = True

End Sub

Sub Events_On()
     Application.EnableEvents = True
End Sub

fonctionne bien mais la date et l'heure ne restent pas figées. Elles s'actualisent à chaque ouverture du fichier.

Bonjour le fil, PatPatrouille

dès que la cellule i15 et modifiée, dans j15 la date apparait et dans k15 l'heure apparait.

Dans ce cas, pourquoi faire une boucle

Mettre dans la feuille concernée ceci

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$I$15" Then
    Application.EnableEvents = False
      Range("K15") = Format(Time, "hh:mm;@")
      Range("J15") = Format(Date, "dd/mm/yy")
    Application.EnableEvents = True
  End If
End Sub

A+

bonjour le fil,

la différence entre la macro de BrunoM45 et la mienne est que ma macro vérifie les changements de la plage I15:I25 et écrit date&heure dans les colonnes J&K. La macro à Bruno ne regarde que la cellule I15. Donc c'est à vous de savoir quelle plage vous voulez vérifier, mais le point le plus important, c'est que nous 2, nous utilisons l'event "Change" et vous continuez à utiliser l'event "Calculate", cela est la cause que toutes les cellules J&K changent. La macro doit commencer avec

Private Sub Worksheet_Change(ByVal Target As Range)

BsAlv

ce code fonctionne parfaitement:

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c     As Range
     Set c = Intersect(Target, Range("I15:I25"))     'seulement les cellules changées de la plage I15:I25)
     If Not c Is Nothing Then
          Application.EnableEvents = False     'blocquer events
          For Each cl In c.Cells     'boucle ces cellules modifiée
               If cl.Value > 0 Then     'non vide
                    cl.Offset(, 2).Value = Format(Time, "hh:mm:ss;@")     '2 cellules vers droite
                    cl.Offset(, 1).Value = Format(Date, "dd/mm/yy")     '1 cellule vers droite
               Else
                    cl.Offset(, 1).Resize(, 2).ClearContents
               End If
          Next
          Application.EnableEvents = True
     End If
End Sub

Le seul "hic" c'est qu'il faut faire enter sur les lignes i15 / i25 sinon les cellules J et K restent en blanc. Hors, sur ces cellules, il n'y a pas à faire enter car sur i15 :i25 c'est une simple formule "=A15" (la colonne A est accessible alors que i est cachée et n'est visible qu'à l'impression du fichier).

En résumé, cette macro fonctionne mais je dois me situer sur i et faire ENTER pour que les valeurs dans J et K soient insérées malgré que nous aillons un WorkSheet Change

Encore merci à tous pour votre aide, ça fait plaisir de partager cela avec vous.

P.

Bonjour PatPatrouille, Le Fil,

cela est la cause que toutes les cellules J&K changent

Erreur, lorsqu'on a une boucle

For Each cl In c.Cells  

Toutes les cellules supérieures à 0 vont changer, même si elles le sont depuis les journées et/ou heures antérieures.

Quand on utilise Time et Date, c'est toujours actualisée.

Ne pas se servir de Aujourdhui() ou Maintenant() ou Now() en VBA mais de Now sans les parenthèses. Afin de ne jamais faire d'actualisation.

Donc,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%
If Not Intersect(Target, Range("I15:I25")) Is Nothing Then
  Application.ScreenUpdating = False
    'Conditions
    If Target = Target(0, 3) Then X = -1 Else X = Target
     Select Case X
      Case Is > 0
      Target.Offset(0, 2) = Format(Now, "hh:mm;@")
      Target.Offset(0, 1) = Format(Now, "dd/mm/yy")
       'case Test, doublon de la colonne I
      Target.Offset(0, 3) = Target
      Case Is = 0
      'RAZ Date/Heure et du Test
        For i = 1 To 3
       Target.Offset(0, i).Clear
       Next i
      Case Else
       'Nothing
     End Select
     Target.Offset(0, 1).Activate
Application.ScreenUpdating = True
End If
End Sub

C'est seulement au changement de la valeur en colonne I (lignes définies) que l'actualisation se fera uniquement sur la ligne ciblée.

Voire, éventuellement ne jamais la modifier si elle présente déjà un jour et une heure.

bonjour le fil,

apparament ce sont les cellules A15:A25 qui changent et les cellules I15:I25 utilisent leur valeurs, donc la macro change en

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c     As Range
     Set c = Intersect(Target, Range("A15:A25"))     'seulement les cellules changées de la plage A15:A25 --> source pour les cellules I15:I25
     If Not c Is Nothing Then
          Application.EnableEvents = False     'blocquer events
          For Each cl In c.Cells     'boucle ces cellules modifiée
               If cl.Value > 0 Then     'non vide
                    cl.Offset(, 10).Value = Format(Time, "hh:mm:ss;@")     '10 cellules vers droite
                    cl.Offset(, 9).Value = Format(Date, "dd/mm/yy")     '9 cellules vers droite
               Else
                    cl.Offset(, 9).Resize(, 2).ClearContents
               End If
          Next
          Application.EnableEvents = True
     End If
End Sub

même si elles le sont depuis les journées et/ou heures antérieures.

@X Cellus, il y a un boucle pour le cas où on change plusieurs cellules en même temps.

Bonjour à tous.

Premièrement merci pour vos aides :-)

J'ai essayé de rajouter ce code pour faire un "enter" mais toujours rien:

Application.SendKeys "{ENTER}"

Ajouté au code que vous m'avez remis:

Private Sub Worksheet_Change(ByVal Target As Range)

'J 'indique la date et l'heure des articles scannés lors de l'impression de l'OF. Macro apportée par https://forum.excel-pratique.com/

Dim i%

' je sélectionne la rangée sur laquelle je me base pour ajouter la date et l'heure:

If Not Intersect(Target, Range("I15:I40")) Is Nothing Then
Application.ScreenUpdating = False

'Conditions:

If Target = Target(0, 3) Then X = -1 Else X = Target
Select Case X
Case Is > 0
Target.Offset(0, 2) = Format(Now, "hh:mm:ss;@")
Application.SendKey = "{ENTER}"
Target.Offset(0, 1) = Format(Now, "dd/mm/yy")
Application.SendKeys "{ENTER}"
' Target.Offset(0, 3) = Target
Case Is = 0

'J'efface les cellules si il n'y a rien dans i:

For i = 1 To 3
Target.Offset(0, i).Clear
Next i
Case Else

End Select
Target.Offset(0, 1).Activate

Application.ScreenUpdating = True

End If

End Sub

Malheureusement ça ne marche pas...

Je vais tenter de modifier le fichier pour pouvoir l'envoyer sur ce forum car en l'état il contient trop d'infos.

Merci encore.

Bonjour PatPatrouille,

Apparemment tu as des formules en colonne I qui se rapportent à la colonne A

If Not Intersect(Target, Range("I15:I40")) Is Nothing Then
Application.ScreenUpdating = False

Donc il faut changer le Range ciblée, à condition que les lignes soient correctes.

If Not Intersect(Target, Range("A15:A40")) Is Nothing Then
Application.ScreenUpdating = False

Suite,

Et surtout ne pas ôter ou mettre en commentaire la ligne de code

Target.Offset(0, 3) = Target
Case Is = 0

Sinon, la condition ne fonctionnera pas convenablement.

If Target = Target(0, 3) Then X = -1 Else X = Target

Si tu ne souhaites pas la colonne L. En prendre une autre plus loin, exemple colonne N Target.Offset(0,5) au lieu de Target.Offset(0,3), voire plus loin encore.

Et change cela dans les deux lignes de code.

A +

Salut X Cellus,

oui, il y a bien une formule dans les cellules i, c'est pour cela que ça ne marche pas?

"Et surtout ne pas ôter ou mettre en commentaire la ligne de code" > Oui, c'était juste une test que je faisais.

Merci encore pour toute ton aide et ton temps.

A nouveau,

Par contre en choisissant la colonne A il faut changer les valeurs des offset.

Donc, cela devrait être Target.Offset(0,9) pour le premier au lieu de Target.offset(0,1)

Et idem pour les autres décaler de 8 unités.

Target.offset(0,10) au lieu de Target.offset(0,2)

Target.offset(0,11) au lieu de Target.offset(0,3) ou selon colonne souhaitée.

Suite,

Voilà,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%
If Not Intersect(Target, Range("A15:A25")) Is Nothing and Target.count= 1 Then
  Application.ScreenUpdating = False
    'Conditions
    If Target = Target(0, 11) Then X = -1 Else X = Target
     Select Case X
      Case Is > 0
      Target.Offset(0, 10) = Format(Now, "hh:mm;@")
      Target.Offset(0, 9) = Format(Now, "dd/mm/yy")
       'case Test, doublon de la colonne I
      Target.Offset(0, 11) = Target
      Case Is = 0
      'RAZ Date/Heure et du Test
      For i = 9 To 11
       Target.Offset(0, i).Clear
       Next i
      Case Else
       'Nothing
     End Select
     Target.Offset(0, 9).Activate
Application.ScreenUpdating = True
End If
End Sub

Si tu souhaites pas la colonne L, prendre une colonne plus éloignée en changeant le Target.Offset(0,11) par le numéro de colonne cible