Intégrer l'affichage du timer dans le shape

duduleray -  
 duduleray -
Bonjour a tous, bonjour forum,

<config>Windows 10 / Edge 80.0.361.109</Excel 2007>

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

7 réponses

Résumé de la discussion

Problématique centrale : intégrer l affichage du décompte dans la shape créée par la macro Excel VBA, qui affiche une zone de texte puis la supprime après quatre secondes. Plusieurs échanges montrent l intention d afficher le décompte directement dans la zone de texte, mais l utilisation actuelle de Application.Wait empêche une mise à jour fluide et ne présente pas le décompte. Des suggestions visent une mise à jour périodique du texte chaque seconde et l utilisation d une boucle DoEvents pour faire progresser le décompte sans bloquer l interface. En cas d évolution, il peut être utile d écarter l attente fixe et d explorer des méthodes plus réactives, comme une minuterie VBA ou une gestion de timer plus fine.

Généré automatiquement par IA
sur la base des meilleures réponses
  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, quel décompte?
    1
    1. duduleray
       
      Salut yg_be,

      Merci pour ta réponse, c'est gentil.

      Juste faire en sorte d'afficher le décompte du timer dans le shape

      La j'ai juste mis 4 secondes pour que ça aille plus vite.

      Merci a toi, bonne soirée et bon app

      Cdlt Dudulleray

       
      Application.Wait Now + TimeValue("00:00:04")  
      
      0
      1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > duduleray
         
        tu veux afficher le nombre de secondes restantes?
        si oui, peux-tu commencer par afficher 4, puis nous montrer le code modifié?
        0
  2. duduleray
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      si tu modifies le code pour afficher 4 dans la shape, je t'expliquerai ensuite que faire pour que ce 4 change et suive le décompte.
      0
  3. duduleray
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      oh, c'est dommage d'avoir ainsi réalisé un shape inutilisable.
      0
  4. duduleray
     
    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
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. duduleray
     
    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
    
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      "00:00:00" s'affiche-t'il bien dans la shape?
      0
    2. duduleray > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
       
      Salut yb_be


      Alors, dès le premier affichage voir ci-dessous.

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


      Et a la fin de la tempo, qui déclenche la macro, qui m'affiche voir ci-dessous.

      MsgBox "essai shape et décompte chrono"
      


      Toujours rien réussi a afficher quelque chose sur le timer, malgré des recherches sur les shapes.

      PS: les messages n'ont aucune significations, c'est juste, voir si ça fonctionne.

      Bonne après midi

      Cdlt Dudulleray
      0
    3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > duduleray
       
      ceci affiche-t-il quelque chose?
      Sheets("Feuil1").Shapes("Mess1").TextFrame.Characters.Text = "Quelque chose"
      0
    4. duduleray > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
       
      ce code ne m'affiche rien du tout
      0
    5. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > duduleray
       
      tu fais l'erreur de perpétuellement créer des shapes, de leur donner le même nom, et de ne jamais les supprimer.
      ajoute donc ceci avant la ligne avec AddTextbox:
      Dim sh As Shape
      For Each sh In Sheets("Feuil1").Shapes
          If sh.Name = "Mess1" Then
              sh.Delete
          End If
      Next sh
      0
  7. duduleray
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      qu'affiche la shape?
      0
  8. duduleray
     
    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
    
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      moi je ferais, en ligne 38:
      ActiveSheet.Shapes("Mess1").TextFrame.Characters.Text = _
            "Info N°1" _
            + Chr(10) + "Entrée non numérique" _
            + Chr(10) +  "00:0" + Krono 
      0
      1. duduleray > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
         
        Re yg_be,

        Merci pour le code, c'est bon ça fonctionne tout comme je le souhaitai, affichage, shape, décompte Timer.
        nickel, nickel merci beaucoup pour ton aide et ton savoir partagé.

        Juste qu'il fallait remplacer le signe (+) par le signe (&) et la, ça fonctionne du feu de Zeus.

        Encore merci a toi et surtout ta patience que je salut.

        Salut yg_be t'inquiète pas, surment a bientôt LoL

        Bien cordialement Dudulleray

        ActiveSheet.Shapes("Mess1").TextFrame.Characters.Text = _
        "Info N°1" _
        & Chr(10) & "Entrée non numérique" _
        & Chr(10) & "00:0" & Krono
        0