Discussion :

[hugo69]

Bonjour,

Voila le code de mon module. Le module efface 3 tables par lintermediaire dune requete prevu dans une macro.Ensuite, le module importe 3 fichiers excel dans des tables.

Le but du module est de maintenir à jour toutes les 5 secondes 3 tables.

Le module se lance lorsque lon clique sur un bouton.

J'aimerai qu'une fois le bouton cliqué, le code du module il se relance toutes les 5 secondes.

voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 PROC()
 
 
      Dim stDocName As String
Application.OnTime Now + TimeValue("00:00:05"), "PROC"
    stDocName = "SUPRESSION"
    DoCmd.RunMacro stDocName
 
    ArticleParFamille = "U:\lien.xls" 'Chemin d'access du fichier
 
strArticleParFamille = "liens"
 
 
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strArticleParFamille, ArticleParFamille, True, ""
 
    ArticleParFamille2 = "U:\Devises.xls" 'Chemin d'access du fichier
 
strArticleParFamille2 = "Devises"
 
 
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strArticleParFamille2, ArticleParFamille2, True, ""
 
    ArticleParFamille3 = "U:\Valeur Produit.xls" 'Chemin d'access du fichier
 
strArticleParFamille3 = "Valeur Produit"
 
 
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strArticleParFamille3, ArticleParFamille3, True, ""
 
 
 
 
End Sub

cest cette partie qui empeche le lancement de la suite du module car si je lenleve limportation se passe bien mais avec ca, ca ne fait rien du tout:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.OnTime Now + TimeValue("00:00:05"), "PROC"

Jai trouvé ca:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim Lheure As Double
Dim Interval As Integer
 
Public Sub LancerTimer(NbS As Integer)
      'L'application ExecutionTimer se lancera toutes les 0 heure, 0 minute et Interval seconde
      Interval = NbS
      ' la ligne suivante va lancer la procédure ExecutionTimer tous les intervalles secondes
      Application.OnTime Now + TimeSerial(0, 0, Interval), "ExecutionTimer"
End Sub
 
Public Sub ArretTimer()
      'Pour arrêter le timer, il suffit d'appeler cette procédure.
On Error Resume Next
      Application.OnTime Lheure, "ExecutionTimer", , False
End Sub
 
Public Sub ExecutionTimer()
      'code à exécuter à la fin de chaque Interval secondes
            'mettez ici votre code
      'code obligatoire 
      Lheure = Now + TimeSerial(0, 0, Interval)
      Application.OnTime Lheure, "ExecutionTimer"
End Sub

Mais je narrive pas à le faire fonctionner.

Jai fait:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim Lheure As Double
Dim Interval As Integer
 
Public Sub LancerTimer(NbS As Integer)
      'L'application ExecutionTimer se lancera toutes les 0 heure, 0 minute et Interval seconde
      Interval = 5
      ' la ligne suivante va lancer la procédure ExecutionTimer tous les intervalles secondes
      Application.OnTime Now + TimeSerial(0, 0, Interval), "ExecutionTimer"
End Sub
 
Public Sub ArretTimer()
      'Pour arrêter le timer, il suffit d'appeler cette procédure.
On Error Resume Next
      Application.OnTime Lheure, "ExecutionTimer", , False
End Sub
 
Public Sub ExecutionTimer()
      'code à exécuter à la fin de chaque Interval secondes
            'mettez ici votre code
      'code obligatoire 
      Lheure = Now + TimeSerial(0, 0, Interval)
      Application.OnTime Lheure, "ExecutionTimer"
End Sub

[argyronet]

Bonjour,

Voici un code qui se lance toutes les 5 secondes:
A toi de l'adapter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub ExecuterProc()
Dim sgnDureePause As Single
Dim sgnDepart As Single
Dim sgnFin As Single
Dim sgnTempsTotal As Single
    'Définition de la durée.
    sgnDureePause = 5
    If MsgBox("Voulez-vous marquer une pause de " & Trim(Str(sgnDureePause)) & " secondes", 36, "Marquer une pause") = 6 Then
        'Définition l'heure de départ.
        sgnDepart = Timer
        Do While Timer < sgnDepart + sgnDureePause
        'Boucle de comparaison qui donne le contrôle à d'autres processus tant que la condition n'est pas vérifiée.
            DoEvents
        Loop
        'Définition l'heure de fin.
        sgnFin = Timer
        'On calcule alors la différence de temps écoulé.
        sgnTempsTotal = sgnFin - sgnDepart
        MsgBox "Et hop !!! 5 seconde de plus...", , "Timer"
        ExecuterProc
    End If
End Sub

Argy

[hugo69]

Merci bcp , ca marche. Jai enlever la demande de confirmation mais du coup je ne sais pas comment l'arreter.

Voici mon code pour info:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ExecuterProc()
Dim sgnDureePause As Single
Dim sgnDepart As Single
Dim sgnFin As Single
Dim sgnTempsTotal As Single
    'Définition de la durée.
    sgnDureePause = 5
 
        'Définition l'heure de départ.
        sgnDepart = Timer
        Do While Timer < sgnDepart + sgnDureePause
        'Boucle de comparaison qui donne le contrôle à d'autres processus tant que la condition n'est pas vérifiée.
            DoEvents
        Loop
        'Définition l'heure de fin.
        sgnFin = Timer
        'On calcule alors la différence de temps écoulé.
        sgnTempsTotal = sgnFin - sgnDepart
        Dim stDocName As String
 
    stDocName = "SUPRESSION"
    DoCmd.RunMacro stDocName
 
    ArticleParFamille = "U:\lien.xls" 'Chemin d'access du fichier
 
strArticleParFamille = "liens"
 
 
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strArticleParFamille, ArticleParFamille, True, ""
 
    ArticleParFamille2 = "U:\Devises.xls" 'Chemin d'access du fichier
 
strArticleParFamille2 = "Devises"
 
 
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strArticleParFamille2, ArticleParFamille2, True, ""
 
    ArticleParFamille3 = "U:\Valeur Produit.xls" 'Chemin d'access du fichier
 
strArticleParFamille3 = "Valeur Produit"
 
 
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strArticleParFamille3, ArticleParFamille3, True, ""
        ExecuterProc
 
End Sub

Je voulais mettre ceci pour l'arreter mais je ne peux pas compiler, il me dit que le ".OnTime" n'existe pas.


Comment arreter cette boucle infinie?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub ArretTimer()
      'Pour arrêter le timer, il suffit d'appeler cette procédure.
On Error Resume Next
      Application.OnTime Now, "ExecuterProc", , False
End Sub

Du coup pas de .mde possible...

[argyronet]

Tu peux faire ceci... (Code légèrement corrigé)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Option Compare Database
Option Explicit
 
Public gboolExecuterEncore As Boolean
 
Public Sub ExecuterProc(ByVal DelaiAttente As Integer)
Const OUI As Boolean = True
'Variable de temps
Dim sgnDepart As Single
Dim sgnFin As Single
Dim sgnTempsTotal As Single
'Tableaux de Strings
Dim straTable(1 To 3)
Dim straPath(1 To 3)
Dim I As Integer
 
    If gboolExecuterEncore = OUI Then
      'Définition l'heure de départ.
      sgnDepart = Timer
      Do While Timer < sgnDepart + DelaiAttente
      'Boucle de comparaison qui donne le contrôle à d'autres processus tant que la condition n'est pas vérifiée.
          DoEvents
      Loop
      'Définition l'heure de fin.
      sgnFin = Timer
      'On calcule alors la différence de temps écoulé.
      sgnTempsTotal = sgnFin - sgnDepart
 
      'Procédure de transfert
      DoCmd.RunMacro "SUPRESSION"
 
      straPath(1) = "U:\lien.xls"
      straPath(2) = "U:\Devises.xls"
      straPath(3) = "U:\Valeur Produit.xls"
      straTable(1) = "liens"
      straTable(2) = "Devises"
      straTable(3) = "Valeur Produit"
 
      For I = 1 To 3
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, straPath(I), straTable(I), True, ""
        DoEvents
      Next I
      ExecuterProc DelaiAttente
    End If
End Sub
 
'A copier dans un formulaire...
Private Sub cmdArreterLesTransferts_Click()
  'Affecte False à la variable de vérification (ce qui arrêtera la procédure)
  gboolExecuterEncore = False
End Sub
 
Private Sub cmdLancerLesTransferts_Click()
Dim intDelaiAttente As Integer
Dim strDelaiAttente As String
  'Défini l'intervalle
  strDelaiAttente = InputBox("Exécuter le transfert toutes les :", "Intervalle en secondes", 5)
  'Vérifie et converti celle-ci
  If IsNumeric(strDelaiAttente) Then intDelaiAttente = CInt(strDelaiAttente)
  'Affecte True à la variable de vérification
  gboolExecuterEncore = True
  'Exécute la procédure
  ExecuterProc intDelaiAttente
End Sub

A copier dans un module dédié
gboolExecuterEncore est une variable dite Public qui prend la valeur True ou False...

Mais il y a un truc que je ne comprends pas...
Pourquoi n'as-tu pas utilisé simplement l'événement Timer du formulaire ?
Cela t'évite ce code !!!

argy

[hugo69]

Jaime bien le légèrement modifié...

Un grand merci à toi, je ne testerai cette fonction qu'en fin de semaine, la pour l'instant jai mis le systeme automatique au lancement du logiciel sans possibilité d'arrêt.

Ca fonctionne bien et je modifierai le code prochainement pour y mettre le tien qui me semble on ne peut plus jolie....

La fonction timer???

Ceci est la première fois que jutilise VB et ca fesait deux an que je ny avais jamais rien compris, la je commence à peine à comprendre les rouages basiques.

Si tu veux je rappatrie des valeurs de produits boursiers dans la base à partir dexcel qui lui se met à jour sur un poste à partir de lien dde style bloomberg.
Les fichiers excel senregistre automatiquement toutes les 1min30.
Chaque poste client a les 3 tables correspondantes en local qui se mettent à jour toutes les 3 minutes.

Ainsi jevite la table excel liée qui empechent plusieurs utilisateurs dacceder à certaines données en meme temp.
Et je lance de facon automatique les mise à jour.

La fonction STOP est pour moi pour quand je lance le logiciel coté developpement et pour quand les utilisateurs veulent allez se balader dans les tables.

En tout cas merci bcp.

Je met ton code en fin de semaine et je te dirai le résultat.