[XL-2003] Comment copier coller des données à intervalle de temps régulier vers un autre classeur

[vincentdulabo]

Bonjour à tous,
Alors voila mon problème,
J'ai un appareil relié à mon ordinateur qui mesure des données en temps réel.
Cet appareil est géré par une macro excel développé par des allemands.
Lorsque je lance l'acquisition de mes données via la macro, un tableau apparait dans un nouveau classeur et mes données sont sensé s'inscrire dans celui ci, hors elles ne s'inscrivent pas.
Mais en revanche mes données sont affichées à gauche de ce tableau dans les cellules D3,D4,D5 et elles varient en temps réel.
Je voudrai donc copier ces trois cellules à intervalle de temps régulier vers un autre classeur, Par exemple dans les cases A1,B1,C1 et que à chaque intervalle de temps donné (ex: 5sec), il y ait un saut de ligne pour accumuler l'ensemble des données.

On m'a dit que cela était possible mais je ne suis pas parvenu à la faire, merci d'avance.
Cordialement.

[Theze]

Bonjour,

Un petit exemple à adapter :
Le code ci-dessous doit être mis dans le classeur où sont enregistrées les valeurs venant de l'appareil (en cellules D3, D4 et D5 si j'ai bien compris ?), il faut inscrire 1 en cellule D1 et lancer la proc "Enregistrer". Le repport des valeurs se fait toutes les 5 secondes les unes à la suites des autres dans le classeur 2 :

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
 
Sub Chrono()
 
    'toutes les 5 secondes
    Application.OnTime Now + TimeValue("00:00:05"), "Enregistrer"
 
End Sub
 
Sub Enregistrer()
 
    Dim Derlig As Long
 
    With Workbooks("Classeur2.xls").Worksheets("Feuil1")
 
        'recherche la première ligne vide en colonne A du classeur où vont
        'être enregistrées les valeurs
        Derlig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
 
        'inscrit les valeurs les unes à la suite des autres à partir de ce classeur
        .Range("A" & Derlig).Value = ThisWorkbook.Worksheets("Feuil1").Range("D3")
        .Range("B" & Derlig).Value = ThisWorkbook.Worksheets("Feuil1").Range("D4")
        .Range("C" & Derlig).Value = ThisWorkbook.Worksheets("Feuil1").Range("D5")
 
    End With
 
    'si D1 est égal à 1 le chrono fonctionne
    If ThisWorkbook.Worksheets("Feuil1").Range("D1") = 1 Then
 
        Chrono
 
    End If
 
End Sub

Hervé.