Barre de progression (avec plusieurs Labels)

Luc St-laurent

XLDnaute Nouveau
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 :)
 

Fichiers joints

job75

XLDnaute Barbatruc
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.
 

Fichiers joints

Luc St-laurent

XLDnaute Nouveau
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

XLDnaute Barbatruc
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.
 

Fichiers joints

Discussions similaires


Haut Bas