Barre de progression (avec plusieurs Labels)

Luc St-laurent · 18 Août 2018

Bonjour à tous,

Alors voilà j'essaie de créer une barre de progression avec plusieurs labels.
J'ai une macro qui m'inscrit un O ou un X dans chaque case de mon classeur.

j'aimerais que lorsque la case est = O le label soit vert et lorsque la case est = X le label soit jaune.
Et lorsque la macro n'a pas encore donnée de réponse le Label reste blanc.

J'ai 31 cases donc 31 Labels dans mon userform.

Voir le fichier ci-joint...
merci pour votre aide

job75 · 19 Août 2018

Bonsoir Luc St-laurent, bienvenue sur XLD,

Code:

Private Sub CommandButton1_Click()
Dim delai#, i%, t#
delai = 0.1 'seconde
For i = 1 To 31
    Me("Label" & i) = ""
    Me("Label" & i).BackColor = &H8000000E
Next
For i = 1 To 31
    Me("Label" & i) = Cells(1, i + 2)
    Me("Label" & i).BackColor = IIf(Cells(2, i + 2) = "O", &HFF00&, IIf(Cells(2, i + 2) = "X", &HFFFF&, &H8000000E))
    t = Timer + delai
    While Timer < t: DoEvents: Wend
Next
End Sub

Fichier joint.

Bonne nuit.

Luc St-laurent · 19 Août 2018

Merci pour votre aide,

Est-ce possible d'actualiser le Userform automatiquement.
Car ma macro prend environ 30 minutes et une nouvelle inscription se fait donc toute les minutes.

C'est donc dire qu'à chaque minute dans la case suivante il y a l'ajout d'un X ou d'un O
et si possible j'aimerais ne pas devoir cliquer sur le Boutton afin d'actualiser le résultat et recommencer le décompte depuis le début.

merci

job75 · 19 Août 2018

Bonjour Luc St-laurent, le forum,

Placez dans le code de Feuil1 (clic droit sur l'onglet et Visualiser le code) :

Code:

Sub Remplissage()
Dim delai#, txt$, i%, t#
delai = 2 / 86400 '2 secondes, à adapter
txt = "OOOOOOOXOOOXXOOOOOOOOOXOOOXXOOO"
With [C2]
    .Resize(, 31) = "" 'RAZ
    For i = 1 To 31
        .Offset(, i - 1) = Mid(txt, i, 1)
        t = Now + delai
        While Now < t: Wend
    Next
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2].Resize(, 31)) Is Nothing Then Exit Sub
Dim i%, c As Range
With Progress_bar
    .Show 0 'non modal
    For i = 1 To 31
        Set c = [C2].Offset(, i - 1)
        If c <> "" Then .Controls("Label" & i) = c(0)
        .Controls("Label" & i).BackColor = IIf(c = "O", &HFF00&, IIf(c = "X", &HFFFF&, &H8000000E))
    Next
    .Controls("Label32") = "Progression " & IIf(c = "", "en cours...", "terminée !")
    DoEvents
    ActiveCell.Activate
End With
End Sub

La macro Remplissage simule celle que vous utilisez, dans la Worksheet_Change il faut impérativement DoEvents.

Fichier (2).

Bonne journée.

Barre de progression (avec plusieurs Labels)

Luc St-laurent

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Luc St-laurent

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires