Demande d'aide Macro.

parazar

XLDnaute Nouveau
Bonjour,

Je cherche de l'aide pour effectuer la fonction suivante :

En A1, j'ai une valeur, issue d'un TCD qui s'actualise automatiquement toutes les minutes.
Le but est de copier à un cycle défini (5mn par exemple) cette valeur sur un ligne ajoutée automatiquement en dessous, avec en A+1 : L'heure d’exécution de la macro, et en B+1, la valeur mémorisée (correspondant à la valeur de A1 au moment de l’exécution de la macro).
Ce qui donnerai par exemple

A1 : 10 (à 8h00) 13 (à 8h01) 17 (à 8h02) 23 (à 8h03)
Donc
A2 = 8h00 - B2 = 10
A3 = 8h01 - B3 = 17
A4 = 8h02 - B4 = 23
Etc..

Merci de votre aide.
 

gmb

XLDnaute Junior
Re : Demande d'aide Macro.

Bonjour

Essaie cette macro à mettre dans la feuille de travail et non dans les modules :
Dim Ln
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A$1")) Is Nothing Then
Ln = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & Ln).Value = Range("A1").Value
Range("B" & Ln).Value = Format(Now - Date, "hh mm")
End If
End Sub
 

Theze

XLDnaute Occasionnel
Re : Demande d'aide Macro.

Bonjour,

Effectivement, selon comment est entrée la valeur dans la cellule, il arrive que l'évènement "Change" ne soit pas déclenché.
Tu peux utiliser un Timer toutes les x secondes ou x minutes afin de récupérer automatiquement la valeur de la cellule A1 et l'heure à laquelle elle est récupérée.
Un exemple avec l'Api "GetTickCount". Pour le test, après avoir collé ce code dans un module standard, pose deux boutons issus de la barre d'outils "Formulaire" et affecte à chacun une macro ("LancerChrono" et "ArreterChrono") puis teste :
Code:
Declare Function GetTickCount Lib "Kernel32" () As Long

Dim Arreter As Boolean

Sub Minuterie(Milliseconde As Long)

    Dim Arret As Long
    
    Arret = GetTickCount() + Milliseconde
    
    Do While GetTickCount() < Arret
    
        DoEvents
        
    Loop

End Sub


Sub LancerChrono()
    
    Dim Cel As Long
    
    'autorise le fonctionnement du chrono
    Arreter = False
    
    'tourne tant que la variable n'est pas à True
    Do While Arreter = False
        
        'en feuille "Feuil1" (à adapter), récupère la première cellule vide
        'de la colonne A, y inscrit l'heure et en colonne B la valeur de A1
        With Worksheets("Feuil1")

            Cel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
            Range("A" & Cel).Value = Format(Time, "hh:mm:ss")
            Range("B" & Cel).Value = Range("A1")
            
        End With
        
        'ici, 2 secondes (valeur en millisecondes), pour une minute = 10000
        Minuterie 2000
        
    Loop
    
End Sub

Sub ArreterChrono()
    
    'arrête le chrono
    Arreter = True
    
End Sub

Hervé.
 

gmb

XLDnaute Junior
Re : Demande d'aide Macro.

Alors fais un autre essai : remplace la macro précedente par :
Private Sub Worksheet_Calculate()
Ln = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & Ln).Value = Range("A1").Value
Range("B" & Ln).Value = Format(Now - Date, "hh mm")
End Sub

Mais chaque fois qu'un calcul sera effectué sur la feuille, une ligne sera ajoutée en colonne A
 

Discussions similaires

Réponses
7
Affichages
485

Statistiques des forums

Discussions
311 711
Messages
2 081 783
Membres
101 817
dernier inscrit
carvajal