temporisation de l'affichage d'un commentaire (vba)

Le
j-pascal
Bonjour,

Le code qui suit ne fonctionne pas :

'-
With commentaire
.Text LeTexte
(bla bla)
.Visible = True '01/05
DoEvents
Stop
Call attend_2_secondes
.Visible = False '01/05
End With
End Sub

Sub attend_2_secondes()
Dim début_attente As Date

début_attente = Time
Do While Time < début_attente + TimeSerial(0, 0, 2)
Loop
End Sub
'-

Je pensais que le "DoEvens" afficherait le commentaire ; si je le mets
mais que je n'insère pas un "Stop", le commentaire ne s'affiche pas.

La temporisation ne fonctionne pas !

Merci pour vos lumières,

jp
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19236841
Bonjour J-Pascal,

Ceci crée et affiche un commentaire pendant 2 secondes
attaché à la cellule A1

'----------------------------------------
Sub test()
Dim T As Double
Dim Commentaire As Comment
With Range("A1")
.ClearComments
Set Commentaire = .AddComment("Bonjour à tous")
End With

t = Timer + 2
With Commentaire
Do While t >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False

End Sub
'----------------------------------------
j-pascal
Le #19236911
Bonjour Denis,

J'ai dû oublier qqch :

'----
Sub Insertion_Commentaire()
Dim T As Double
Dim Commentaire As Comment

With ActiveSheet
.Unprotect '01/05
With [d3]
.Select
.ClearComments
Set Commentaire = .AddComment
End With
End With
'Stop
LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" &
NomFichierImport & "]"
With Commentaire
.Text LeTexte
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
'---
T = Timer + 2
With Commentaire
Do While T >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False
'---
End With
End Sub
'----

jp

Bonjour J-Pascal,

Ceci crée et affiche un commentaire pendant 2 secondes
attaché à la cellule A1

'----------------------------------------
Sub test()
Dim T As Double
Dim Commentaire As Comment
With Range("A1")
.ClearComments
Set Commentaire = .AddComment("Bonjour à tous")
End With

t = Timer + 2
With Commentaire
Do While t >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False

End Sub
'----------------------------------------


j-pascal
Le #19237231
Je viens de déplacer l'intégralité de ton code, dans ma procédure, et
ça ne fonctionne pas.

(J'avais déclaré "Fichier" en tant que "Public" dans une autre Proc.)

Mystère ! (Je vais comparer les deux codes)

jp

'-------------------------------------------------
Sub Insertion_Commentaire()
Dim T As Double, LeTexte As String
Dim Commentaire As Comment

LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" & NomFichierImport &
"]"

With ActiveSheet
.Unprotect '01/05
With .Range("D3")
.ClearComments
Set Commentaire = .AddComment(LeTexte)
End With
End With
With Commentaire
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
T = Timer + 2
Do While T >= Timer
DoEvents
.Visible = True
Loop
.Visible = False
End With
End Sub
'-------------------------------------------------





"j-pascal" discussion : Bonjour Denis,

J'ai dû oublier qqch :

'----
Sub Insertion_Commentaire()
Dim T As Double
Dim Commentaire As Comment

With ActiveSheet
.Unprotect '01/05
With [d3]
.Select
.ClearComments
Set Commentaire = .AddComment
End With
End With
'Stop
LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" &
NomFichierImport & "]"
With Commentaire
.Text LeTexte
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
'---
T = Timer + 2
With Commentaire
Do While T >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False
'---
End With
End Sub
'----

jp

Bonjour J-Pascal,

Ceci crée et affiche un commentaire pendant 2 secondes
attaché à la cellule A1

'----------------------------------------
Sub test()
Dim T As Double
Dim Commentaire As Comment
With Range("A1")
.ClearComments
Set Commentaire = .AddComment("Bonjour à tous")
End With

t = Timer + 2
With Commentaire
Do While t >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False

End Sub
'----------------------------------------




j-pascal
Le #19237221
En mode pas à pas, Ca passe de :

Do While T >= Timer

[DoEvents]
[.Visible = True]
[Loop]

à :

.Visible = False

jp



'-------------------------------------------------
Sub Insertion_Commentaire()
Dim T As Double, LeTexte As String
Dim Commentaire As Comment

LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" & NomFichierImport &
"]"

With ActiveSheet
.Unprotect '01/05
With .Range("D3")
.ClearComments
Set Commentaire = .AddComment(LeTexte)
End With
End With
With Commentaire
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
T = Timer + 2
Do While T >= Timer
DoEvents
.Visible = True
Loop
.Visible = False
End With
End Sub
'-------------------------------------------------





"j-pascal" discussion : Bonjour Denis,

J'ai dû oublier qqch :

'----
Sub Insertion_Commentaire()
Dim T As Double
Dim Commentaire As Comment

With ActiveSheet
.Unprotect '01/05
With [d3]
.Select
.ClearComments
Set Commentaire = .AddComment
End With
End With
'Stop
LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" &
NomFichierImport & "]"
With Commentaire
.Text LeTexte
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
'---
T = Timer + 2
With Commentaire
Do While T >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False
'---
End With
End Sub
'----

jp

Bonjour J-Pascal,

Ceci crée et affiche un commentaire pendant 2 secondes
attaché à la cellule A1

'----------------------------------------
Sub test()
Dim T As Double
Dim Commentaire As Comment
With Range("A1")
.ClearComments
Set Commentaire = .AddComment("Bonjour à tous")
End With

t = Timer + 2
With Commentaire
Do While t >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False

End Sub
'----------------------------------------




j-pascal
Le #19237731
Je n'ai jamais douté que la procédure fonctionne...

Je l'ai testé dans les conditions que tu indiques. C'est bon.
Je l'ai retesté dans mon classeur. C'est bon.

Par contre, comme cette procédure est appelée par une autre procédure ;
là, ça ne fonctionne plus. Je précise que le commentaire s'efface, se
crée, se met au format, etc. mais comme je te l'indiquais dans le
dernier message on passe de "Do While T >= Timer" à .Visible = False"
(en shuntant donc : "DoEvens, .Visible = True, Loop"

Mystère ...

Jp

La procédure soumise fonctionne très bien.
Prends un fichier vierge, tu copies la procédure dans un module standard,
et tu l'exécutes à partir de l'interface de calcul pour pouvoir observer
l'effet.



"j-pascal" discussion : En mode pas à pas, Ca
passe de :

Do While T >= Timer

[DoEvents]
[.Visible = True]
[Loop]

à :

.Visible = False

jp



'-------------------------------------------------
Sub Insertion_Commentaire()
Dim T As Double, LeTexte As String
Dim Commentaire As Comment

LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" & NomFichierImport &
"]"

With ActiveSheet
.Unprotect '01/05
With .Range("D3")
.ClearComments
Set Commentaire = .AddComment(LeTexte)
End With
End With
With Commentaire
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
T = Timer + 2
Do While T >= Timer
DoEvents
.Visible = True
Loop
.Visible = False
End With
End Sub
'-------------------------------------------------





"j-pascal" discussion : Bonjour Denis,

J'ai dû oublier qqch :

'----
Sub Insertion_Commentaire()
Dim T As Double
Dim Commentaire As Comment

With ActiveSheet
.Unprotect '01/05
With [d3]
.Select
.ClearComments
Set Commentaire = .AddComment
End With
End With
'Stop
LeTexte = "Fichier exporté : " & Fichier & vbCrLf & "[" &
NomFichierImport & "]"
With Commentaire
.Text LeTexte
With .Shape
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = 4 '22
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
With .OLEFormat.Object
.Font.Name = "verdana"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = 2
.AutoSize = True
End With
End With
'---
T = Timer + 2
With Commentaire
Do While T >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False
'---
End With
End Sub
'----

jp

Bonjour J-Pascal,

Ceci crée et affiche un commentaire pendant 2 secondes
attaché à la cellule A1

'----------------------------------------
Sub test()
Dim T As Double
Dim Commentaire As Comment
With Range("A1")
.ClearComments
Set Commentaire = .AddComment("Bonjour à tous")
End With

t = Timer + 2
With Commentaire
Do While t >= Timer
DoEvents
Commentaire.Visible = True
Loop
End With
Commentaire.Visible = False

End Sub
'----------------------------------------






j-pascal
Le #19237981
(avec les accords du participe passé, c'est mieux ;-) )

Je n'ai jamais douté que la procédure fonctionne...

Je l'ai testée dans les conditions que tu indiques. C'est bon.
Je l'ai retestée dans mon classeur. C'est bon.

Par contre, comme cette procédure est appelée par une autre procédure ;
là, ça ne fonctionne plus. Je précise que le commentaire s'efface, se
crée, se met au format, etc. mais comme je te l'indiquais dans le
dernier message on passe de "Do While T >= Timer" à .Visible = False"
(en shuntant donc : "DoEvens, .Visible = True, Loop"

Mystère ...

Jp
michdenis
Le #19238141
Es-tu certain d'avoir placé cette ligne de code
T = Timer + 2 avant le Do while ...




"j-pascal" news:
(avec les accords du participe passé, c'est mieux ;-) )

Je n'ai jamais douté que la procédure fonctionne...

Je l'ai testée dans les conditions que tu indiques. C'est bon.
Je l'ai retestée dans mon classeur. C'est bon.

Par contre, comme cette procédure est appelée par une autre procédure ;
là, ça ne fonctionne plus. Je précise que le commentaire s'efface, se
crée, se met au format, etc. mais comme je te l'indiquais dans le dernier
message on passe de "Do While T >= Timer" à .Visible = False" (en shuntant
donc : "DoEvens, .Visible = True, Loop"

Mystère ...

Jp




j-pascal
Le #19238801
Oui, comme ceci :

T = Timer + 2
Do While T >= Timer
DoEvents
.Visible = True
Loop
.Visible = False

Pour être sûr de ne pas passer à côté d'une modification, j'avais fait
un "copier/coller" de ton code !

Ce code fonctionne très bien dans un autre classeur. Par contre, le
fait que cette procédure soit appelée par une autre procédure semble
(?) être le problème ! Pas à pas, il shunte : "DoEvens, .Visible =
True, Loop"

jp

Es-tu certain d'avoir placé cette ligne de code
T = Timer + 2 avant le Do while ...




"j-pascal" news:
(avec les accords du participe passé, c'est mieux ;-) )

Je n'ai jamais douté que la procédure fonctionne...

Je l'ai testée dans les conditions que tu indiques. C'est bon.
Je l'ai retestée dans mon classeur. C'est bon.

Par contre, comme cette procédure est appelée par une autre procédure ; là,
ça ne fonctionne plus. Je précise que le commentaire s'efface, se crée, se
met au format, etc. mais comme je te l'indiquais dans le dernier message on
passe de "Do While T >= Timer" à .Visible = False" (en shuntant donc :
"DoEvens, .Visible = True, Loop"

Mystère ...

Jp






j-pascal
Le #19238791
Si j'ajoute un "On Error Resume Next" :

- Ca fonctionne en pas à pas (affichage temporisé du commentaire)
- Ca ne fonctionne pas en exécution normale !!

Etant donné que l'erreur n'est pas traitée, je ne vois pas pourquoi ça
fonctionne dans le premier cas !!

'----------
T = Timer + 2

Do While T >= Timer
On Error Resume Next
'DoEvents
.Visible = True
Loop
.Visible = False
'----------

jp

Es-tu certain d'avoir placé cette ligne de code
T = Timer + 2 avant le Do while ...




"j-pascal" news:
(avec les accords du participe passé, c'est mieux ;-) )

Je n'ai jamais douté que la procédure fonctionne...

Je l'ai testée dans les conditions que tu indiques. C'est bon.
Je l'ai retestée dans mon classeur. C'est bon.

Par contre, comme cette procédure est appelée par une autre procédure ; là,
ça ne fonctionne plus. Je précise que le commentaire s'efface, se crée, se
met au format, etc. mais comme je te l'indiquais dans le dernier message on
passe de "Do While T >= Timer" à .Visible = False" (en shuntant donc :
"DoEvens, .Visible = True, Loop"

Mystère ...

Jp






j-pascal
Le #19238761
(avec ou sans DoEvents)

Es-tu certain d'avoir placé cette ligne de code
T = Timer + 2 avant le Do while ...




"j-pascal" news:
(avec les accords du participe passé, c'est mieux ;-) )

Je n'ai jamais douté que la procédure fonctionne...

Je l'ai testée dans les conditions que tu indiques. C'est bon.
Je l'ai retestée dans mon classeur. C'est bon.

Par contre, comme cette procédure est appelée par une autre procédure ; là,
ça ne fonctionne plus. Je précise que le commentaire s'efface, se crée, se
met au format, etc. mais comme je te l'indiquais dans le dernier message on
passe de "Do While T >= Timer" à .Visible = False" (en shuntant donc :
"DoEvens, .Visible = True, Loop"

Mystère ...

Jp






Publicité
Poster une réponse
Anonyme