Excel VBa espace pile insuffisant [Résolu]

Re,

J'ai cherché un peu et e suis tombé sur un site qui explique comment programmer un timer.

http://www.cpearson.com/excel/OnTime.aspx

Le plus petit intervalle est de 1 seconde, pour faire un chrono au 1 centième c'est pas suffisant mais j'ai réussi à afficher une horloge sur une userform.

Voici comment j'ai fait:

1) Dans un module, je mis ça:

Option Explicit

Public RunWhen As Double
Public Const cRunIntervalSeconds = 1 ' 1 seconde
Public Const cRunWhat = "Macro1"  ' the name of the procedure to run

Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=False
End Sub

Sub Macro1()
   '''''''''''''''''
   ' Your Code Here
   '''''''''''''''''
   UserForm1.Label1.Caption = Time
   ' Call StartTimer to schedule the procedure again
   StartTimer
End Sub

2) Sur une UserForm (UserForm1) j'ai mis 2 boutons (CommandButton1 et CommandButton2), et 1 Label (Label1).
Dans le code de la Userform j'ai mis ça:

Option Explicit

Private Sub CommandButton1_Click()
StartTimer
End Sub

Private Sub CommandButton2_Click()
StopTimer
End Sub

Private Sub UserForm_Terminate()
StopTimer
End Sub

3) J'affiche UserForm1, Clic sur bouton1, l'horloge démarre. Clic sur bouton2, l'horloge s'arrête.

Dans Public Const cRunIntervalSeconds tu règles l'intervalle.
Dans macro1 à la place de MsgBox, tu peux mettre la procédure à exécuter à chaque interruption Timer.

J'espère que ça te dépannera.
Salut.

Bonjour,
Peut-être un peu plus simple pour un timer avec 1 seconde de tempo.

Dans un module de feuille
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Pour exemple d'application Démarre/Arrète le timer à chaque changement de cellule.
'mais peu être mis sur un bouton
    TimeOnOFF = Not TimeOnOFF
    If TimeOnOFF Then Timer
End Sub

Dans un module public
Public TimeOnOFF As Boolean

Sub Timer()
Dim S As Integer
    While TimeOnOFF = True
        If Second(Now) > S Or Second(Now) = 0 Then
            'Exécution du code
            'pour exemple
            Sheets("Feuil1").Range("A1").Value = Time
            S = Second(Now)
        End If
        DoEvents
    Wend
    
End Sub

A+

Bonjour,

la ligne

  Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=False 

se trouve dans la procédure StopTimer, elle est sensée stoper l'execution des taches planifiée (Schedule).

Tu remarqueras que dans la procédure, cette ligne de code est précédée par On Error Resume Next, ce qui veut dire que l'auteur a prévu que l'execution de Schedule:=False pouvait occasionner une erreur.

Pour arrêter le Timer, appelle StopTimer, normalement il ne devrait plus y avoir de problème.
Arrête le Timer quand tu ferme la feuille ( Private Sub UserForm_Terminate() ).

De plus l'appel à la procédure StartTimer qui prépare le Timer pour l'interuption suivante doit être à la dernière ligne de la macro qui execute ton code.

Sub Macro1() '<- nom de la macro initialisée dans la constante cRunWhat
   ' les instructions de ta macro à executer
   '...
   '...
   StartTimer '<- dernière instruction
End Sub

A+.

Bonjour,

Ce message peut arriver quand une fonction s'appelle elle-meme recursivement un grand nombre de fois, ou alors quand passe un argument par valeur et que cet argument est un grand tableau ou un texte important.

Que fait exactement ta macro.

A+.

Dans les objets activeX, il y a un controle Timer qui permet de faire ça.

Regarde si ça peut t'arranger, sinon il faudra s'y prendre autrement.

A+.

Le controle Timer existe pour VB6, mais je ne l'ai pas trouvé non plus pour VBA.

Il y a encore la fonction timer() qui peut etre utile.
Je regarde comment régler le problème et je posterai ma reponse tout à l'heure.

A+.

pardon,

j'ai dit MsgBox dans macro1 mais c'est UserForm1.Label1.Caption = Time
A+.

OK ca marche
je met pas mon code c'est le même que celui au dessus
merci à toi amigo

a+

salut

Je vais expliquer umpeu mieu le contexte, les evenements declencheurs et la solution

je doit déclencher un timer sur recalcul de la feuil mais seulement si certaine cellule sont a "2"
et le truc c'est que lorseque le timer est lancé je ne veut pas pouvoir en relancer un "Logique"
j'ai donc utiliser un compteur que j'incremente quand je met en route le timer et que je decremente quand je l'arrete

Pour mon probleme d'arret du compteur

en fait dans Sub Macro1() avant je ne fesait pas de test je relancais le timer directement
c'est la qu'etait mon erreur
donc maintenant je test l'etat de mes cellule et suivant le resultat je relance le timer ou pas

vous comprenderez mieux avec le code


debut du module timer

Option Explicit

Public RunWhen As Date
Dim cRunIntervalSeconds As Integer
Public Const cRunWhat = "Macro1" ' the name of the procedure to run

Sub StartTimer()

If ActiveSheet.cells(19, 1).value = "" Then
cRunIntervalSeconds = 2
Else
cRunIntervalSeconds = CInt(ActiveSheet.cells(19, 1).value)
End If
RunWhen = Now + TimeValue("0: 0: " & cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=True

End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, Schedule:=False

End Sub

Sub Macro1()

Dim Mcp As Object
Dim var As Variant
Dim j As Integer
Dim Cmpttimer As Integer

var = Array("Cmpt_statistique")
Set Mcp = CreateObject("WinCC-Runtime-Project")
Cmpttimer = Mcp.GetValue(var(0))

Feuil1.Begin "c'est la procedure que je veut executer cycliquement
' Call StartTimer to schedule the procedure again

If ActiveSheet.cells(11, 2).value = "2" Or ActiveSheet.cells(11, 5).value = "2" Or ActiveSheet.cells(11, 8).value = "2" Then
StartTimer
Cmpttimer = 2
j = Mcp.SetValue(var(0), Cmpttimer)
Range("A11").Select
ActiveCell.FormulaR1C1 = ""
End If

If ActiveSheet.cells(11, 2).value <> "2" And ActiveSheet.cells(11, 5).value <> "2" And ActiveSheet.cells(11, 2).value <> "2" Then
StopTimer
Cmpttimer = 0
j = Mcp.SetValue(var(0), Cmpttimer)
End If

End Sub

voila j'espere que ca sera utile a quelqu'un et si un autre quelqu'un a rien compris qu'il le dise j'essayerai d'etre plus clair

merci de votre aide

Bonjour,

D'aprés ce que dit le type qui à écrit l'article, tu peux programmer plusieurs taches, il faut les mettre dans des variables distinctes.
On peut aussi essayer de paramétrer les procédures StartTimer et StopTimer

Déclare 2 variables RunWhen1 et RunWhen2

Public RunWhen1 As Double
Public RunWhen2 As Double

Sub StartTimer(HeureExec as double, MaMacro as String)
    Application.OnTime EarliestTime:=HeureExec, Procedure:=MaMacro, Schedule:=True
End Sub

Tu règle l'heure et tu déclenche la planification de tes taches en appelant StartTimer.

RunWhen1= Now + TimeSerial(0,0,5) 'execution dans 5 secondes
' ou encore RunWhen1=TimeSerial(12,0,0) ' execution à 12h précises
StartTimer(RunWhen1,"macro1")

RunWhen2= Now + TimeSerial(0,1,0) 'execution dans 1 minute
StartTimer(RunWhen2,"macro2")

Ensuite tes macros déclenchent une nouvelle programmation après execution
<code>
Sub Macro1()
   ' les instructions de ta macro1 à executer
   RunWhen1= Now + TimeSerial(0,0,5) 'nouvelle execution dans 5 secondes
   StartTimer(RunWhen1,"macro1")
End Sub

Sub Macro2()
   ' les instructions de ta macro2 à executer
   RunWhen2= Now + TimeSerial(0,1,0) ' nouvelle execution dans 1 minute
   StartTimer(RunWhen2,"macro2")
End Sub

Pour arreter le Timer c'est la meme chose

Sub StopTimer(HeureExec as double, MaMacro as String)
    On Error Resume Next
    Application.OnTime EarliestTime:=HeureExec, Procedure:=MaMacro, Schedule:=False
End Sub

Appel de StopTimer

StopTimer(RunWhen1,"macro1")
StopTimer(RunWhen2,"macro2")

Je n'ai pas testé, mais d'aprés l'article, si j'ai bien compris, c'est comme que ça marche.

A+.

Bonsoir,

Function nor(x As Double)
   nor = 0.5 + 0.3989423 * ((x - x ^ 3) / 6 + (x ^ 5) / 40)
End Function

avec nor(x) tu la rappelles indéfiniment

Mais crée une nouvelle discussion la prochaine fois, tu augmentes tes chances d'être lu...
eric