Intégrer l'affichage du timer dans le shape Fermé

Question

Bonjour a tous, bonjour forum, Windows 10 / Edge 80.0.361.109 La petite macro ci-dessous fonctionne bien et affiche un shape tout simplement. On lance la macro qui affiche un shape et s'efface automatiquement au bout de 4 secondes je souhaiterai intégrer l'affichage du DECOMPTAGE dans le shape, je n'y arrive pas. Merci a vous pour votre aide, bonne fin d'après midi. Cdlt Duduleray Sub Information_N°1() Dim L As Single, T As Single, H As Single, W As Single '### Dimensions et position de la zone de texte H = 100 '*** ^ Height = Hauteur W = 300 '*** < > Width Largeur L = (Application.UsableWidth / 2) - (W / 2) '*** < Left gauche Position horizontale au centre de l'écran T = (Application.UsableHeight / 2) - (H / 2) '*** > Right droite Position verticale au centre de l'écran '### Repositionnement de l'écran Range("A1").Activate '### Insertion de la zone de texte et paramétrage du texte ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, L, T, W, H).Select With Selection .Name = "Mess1" '<-- Nom zone de texte - Chr(10) saut de ligne .Characters.Text = "Info N°1" & Chr(10) & "Entrée non numérique" '<-- Message .HorizontalAlignment = xlCenter '<-- Texte centré horizontalement .VerticalAlignment = xlCenter '<-- Texte centré verticalement .ShapeRange.Fill.ForeColor.SchemeColor = 0 '<-- Couleur de fond .Font.ColorIndex = 43 '<-- Couleur du texte .Font.Size = 12 '<-- Taille de la police de caractères .Font.Bold = True '<-- Style gras End With Range("A1").Activate '----------- '### Ajout d'un timer pour effacement automatique zone de texte Application.Wait Now + TimeValue("00:00:04") '<-- Effacement après 4 secondes ActiveSheet.Shapes("Mess1").Delete '<-- Effacement message End Sub

yg_be · Answer

bonjour, quel décompte?

duduleray · Answer

Re 

oui effectivement le nombre de secondes restantes pour essai ici j'ai 4 secondes 

"si oui, peux-tu commencer par afficher 4, puis nous montrer le code modifié?"

le code dans l'état actuel, la shape s'affiche et le décompte se fait sans affichage (rien) mais il s'efface au bout du temps ici 4 secondes, mais on ne vois rien.

c'est justement le but voir le décompte dans la shape

Merci bien, 

Cdlt Dudulleray

duduleray · Answer

Re 

j'ai déja essayer et justement je n'arrive pas a afficher quoi que ce soit dans le shape

c'est un code trouver sur le net et en plus je ne connais pas les shapes.

merci a toi pour ton aide.

Cdlt  Dudulleray

duduleray · Answer

Bonjour yg_be,

Merci pour la réponse,

Non, ce n'ai inutilisable, ça fonctionne, ça fait comme une Msgbox, sauf que après le message la shape s'éteint automatiquement.

Donc je me suis dit que si on pouvais intégrer le décompte du Timer ça serait plus cool.
J'ai essayer bien sur, j'ai regarder sur le net mais pas trouver comment écrire ce code pour afficher se que je souhaitai.

Merci et bonne journée, a toi.
Cdlt Duduleray

duduleray · Answer

Salut yg_be

J'ai fait des essais ce matin, donc le code ci-dessous fonctionne.
quand je lance la macro, le shape s'affiche bien avec les messages
et au bout de 4 secondes j'ai bien la macro qui lance le message MGSBOX et qui s'affiche
MAIS toujours pas d'affichage du décompte dans la shape, j'arrive pas ????

Bon app et bonne journée

Cdlt dudulleray

Option Explicit
Sub Information_N°1()
    Dim L As Single, T As Single, H As Single, W As Single
    'Dim Tps, Krono, Start, Pause
    Dim tempsChrono: Dim chrono As Double, temp
'### Dimensions et position de la zone de texte
H = 100                                                      '*** ^ Height = Hauteur
W = 300                                                     '*** < > Width Largeur
L = (Application.UsableWidth / 2) - (W / 2)    '*** < Left gauche Position horizontale au centre de l'écran
T = (Application.UsableHeight / 2) - (H / 2)    '*** > Right droite Position verticale au centre de l'écran

Range("A1").Activate                                                                                   '### Repositionnement de l'écran

'### Insertion de la zone de texte et paramétrage du texte
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, L, T, W, H).Select
    With Selection
            .Name = "Mess1"                                                                              '<-- Nom zone de texte - Chr(10) saut de ligne
            .Characters.Text = "Info N°1" & Chr(10) & "Entrée non numérique"       '<-- Message
            .HorizontalAlignment = xlCenter                                                          '<-- Texte centré horizontalement
            .VerticalAlignment = xlCenter                                                              '<-- Texte centré verticalement
            .ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 255)                         '<-- Couleur de fond
            .Font.ColorIndex = 3                                                                          '<-- Couleur du texte
            .Font.Size = 14                                                                                  '<-- Taille de la police de caractères
            .Font.Bold = True                                                                               '<-- Style gras
    End With

'Range("A1").Activate

'### Décompte Chrono()
Sheets("Feuil1").Shapes("Mess1").TextFrame.Characters.Text = chrono & " s"
temp = chrono / 3600
Sheets("Feuil1").Shapes("Mess1").TextFrame.Characters.Text = Format(temp / 24, "00:00:00")
chrono = chrono + 1
tempsChrono = Now + TimeValue("00:00:4")

Application.OnTime tempsChrono, "majChrono"        '<-- Appel macro a fin tempo 4 secondes
End Sub

Sub majChrono()
MsgBox "essai shape et décompte chrono"
End Sub

duduleray · Answer

Re 

Je n'arrive pas a afficher quoi que se soit concernant le timer
mais le timer fonctionne bien puisque la macro se déclenche juste a 4 secondes
et affiche le message que j'ai mis dans la MSGBOX

merci je vais déjeuner ,je reprends après, confinage oblige autant s'occuper.

bon app

duduleray · Answer

Salut yg_be,

Voila, je suis arrivé a avancer, j'ai repris un ancien code de chrono et j'ai adapter, ce qui donne
presque une solution a ce que je souhaitai.

Le décompte se fait bien dans le shape juste au milieu.
Mais je n'arrive pas a afficher les deux messages ci-dessous avec en plus le Timer.

  .Characters.Text = "Info N°1" & Chr(10) & "Entrée non numérique"

Normalement je devrais avoir 3 lignes centrer d'afficher :

- Info N°1
- Entrée non numérique
- 00:00 --> Timer qui décompte

Merci pour ton aide, j'ai avancer en revoyant la chose.
Du coup ça fonctionne MAIS manque 2 affichages

Cdlt Dudulleray

Sub Information_N°1()
       Dim L As Single, T As Single, H As Single, W As Single
       Dim Tps, Krono, Start, Pause, Sh As Shape

'### Dimension et position zone de texte
H = 150                                                      '*** ^ Height = Hauteur
W = 300                                                     '*** < > Width Largeur
L = (Application.UsableWidth / 2) - (W / 2)    '*** < Left gauche Position horizontale au centre de l'écran
T = (Application.UsableHeight / 2) - (H / 2)    '*** > Right droite Position verticale au centre de l'écran

For Each Sh In Sheets("Feuil1").Shapes                                  '<-- Test empèche d'avoir des doublons de shape
    If Sh.Name = "Mess1" Then
       Sh.Delete
    End If
Next Sh

'### Insertion de la zone de texte et paramétrage du texte
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, L, T, W, H).Select
    With Selection
         .Name = "Mess1": Pause = 5                                                             '<-- Nom shape --- Pause en secondes
         .Characters.Text = "Info N°1" & Chr(10) & "Entrée non numérique"       '<-- Message Nom zone texte-Chr(10) saut de ligne
      
         .HorizontalAlignment = xlCenter                                                          '<-- Texte centré horizontalement
         .VerticalAlignment = xlCenter                                                              '<-- Texte centré verticalement
         
         .ShapeRange.Fill.ForeColor.RGB = RGB(0, 255, 255)                         '<-- Couleur de fond interior
         .Font.ColorIndex = 3                                                                          '<-- Couleur du texte font
         .Font.Size = 14                                                                                  '<-- Taille police des caractères
         .Font.Bold = True                                                                               '<-- Style gras
    End With
Range("A1").Activate

'### Décompte Krono()
Tps = Now: Start = Timer                                             '<-- Définit le début.
    Do While Timer < Start + Pause
    DoEvents
        Krono = Pause - Second(Now - Tps)
    ActiveSheet.Shapes("Mess1").TextFrame.Characters.Text = "00:0" & Krono
    Loop

 Call majChrono                                                            '<-- Appel macro
End Sub

Sub majChrono()
        MsgBox "Essai shape et décompte chrono"
        ActiveSheet.Shapes("Mess1").Visible = False     '<-- Effacement shape Mess1
End Sub

Intégrer l'affichage du timer dans le shape

7 réponses

Discussions similaires