ProgressBar et UserForm

Nougat7

XLDnaute Nouveau
Bonjour le forum!

Cela fait bien longtemps que je n'ai pas eu de soucis avec mes connaissance en VBA Excel mais l'inévitable vient d'arriver...

Voulant ajouter une barre de progression du traitement d'une macro je me suis donc mis en recherche d'exemples de code sur excel downloads bien evidemment et je suis tombé sur plusieurs exemples qui m'ont plus ou moins satisfait, par soucis de portabilité d'un poste a un autre, j'aimerai donc intégrer une progressBar sans rien devoir rajouter (donc sans cocher Microsoft ProgressBar Control, version 6.0).

Je suis donc tombé sur deux exemples me semblant satisfaisant de ce coté là:
Lien supprimé
et surtout:
Excel Developer Tip: Displaying a Progress Indicator (Excel 97)

J'ai donc bien créé mon UserForm contenant un TextBox coloré que j'agrandit en largeur au fur et a mesure de l'avancement de la macro (taille max de ma progressBar: Width=100), le code donne ca:

Dans le module contenant le code principal

Code:
Public taille_progressbar As Byte
Sub main()
    
    'declarations...
    
    taille_progressbar = 0
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...
    
End sub

Code de l'UserForm1:

Code:
' Execution automatique de ce code apres l'appel d'un UserFormX.Show
Private Sub UserForm_Activate()
    UserForm1.TextBox1.Width = taille_progressbar
    DoEvents
End Sub

' Empêche la fermeture intempestive par la croix
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

Voila mon soucis est que l'avancement de la barre ne s'effectue pas car l'execution se fige à la fin du premier "UserForm_Activate", j'ai bien essayer en mettant un Hide Me ou Unload Me mais l'affichage de l'UserForm devient trop rapide pour y voir une quelconque progression...que dois-je faire pour sortir du "UserForm_Activate" tout en gardant le focus sur justement mon UserForm.....

Merci par avance et bonne fin de journée ;)
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Re : ProgressBar et UserForm

Bonjour

essaies ainsi

Code:
Private Sub UserForm_Activate()

    taille_progressbar = 0
    
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
TextBox1.Width = taille_progressbar
    'code...boucles...
    taille_progressbar = taille_progressbar + 25
TextBox1.Width = taille_progressbar
    'code...boucles...
    taille_progressbar = taille_progressbar + 25
TextBox1.Width = taille_progressbar
    'code...boucles...
    taille_progressbar = taille_progressbar + 25
TextBox1.Width = taille_progressbar

End Sub
 

Nougat7

XLDnaute Nouveau
Re : ProgressBar et UserForm

Bonjour et Merci Pascal76!

Si j'ai bien compris ce que tu me propose, c'est de mettre mon code principal dans le "UserForm_Activate", effectivement ca doit marcher mais je ne souhaite pas faire comme ca car je tiens à garder mon code principal dans un module.

En bidouillant un peu j'ai obtenu ce que je voulais, cela ne me semble pas très propre mais ca a l'air de bien marcher... voila ce que j'ai fait.

Dans le module contenant le code principal:

Code:
Public taille_progressbar As Byte
Sub main()
    
    'declarations...
    
    Application.ScreenUpdating = False
    
    taille_progressbar = 0
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...boucles...
    
    taille_progressbar = taille_progressbar + 25
    UserForm1.Show
    
    'code...
    
    Application.ScreenUpdating = True
    Unload UserForm1
    
End sub

Sub barre_progression()
    UserForm1.TextBox1.Width = taille_progressbar
    DoEvents
    UserForm1.Hide
End Sub

Code de l'UserForm1:

Code:
' Execution automatique de ce code apres l'appel d'un UserFormX.Show
Private Sub UserForm_Activate()
    barre_progression
End Sub

' Empêche la fermeture intempestive par la croix
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

Voila, si vous voulez apporter de amélioration ou m'apprendre une meilleur façon de faire je suis preneur :D en tout cas merci pour votre aide toujours salutaire!
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Re : ProgressBar et UserForm

Re

Bon pas eu le temps hier soir

Voilà un petit truc que j'avais réalisé gràce à un code récupéré sur le forum

Rajoutes des données dans la colonne A (jusqu'à 10000 lignes tu peux) pour bien voir l'avancement. Attention là ça défile car je ne fais rien dans le code donc avec un vrai code tu n'as pas ce scintillement
 

Pièces jointes

  • Frmprogress.zip
    15.9 KB · Affichages: 1 028
  • Frmprogress.zip
    15.9 KB · Affichages: 1 045
  • Frmprogress.zip
    15.9 KB · Affichages: 1 078

altefqhatre

XLDnaute Junior
Re : ProgressBar et UserForm

UP :p

J'ai un souci avec l'userform également :-S

J'ai mis UserForm.Show 0, elle s'affiche bien mais tout en blanc :-S

Comme si elle était mise en arrière plan en fait

Qqun a une idée?

Je m'y connais pas vraiment mais j'ai trouver ce code que j'ai mis dans l'userform:

Code:
Sub StartProcessing1()
 ' Affiche une barre de progression tant qu'une macro tourne.
 'Nécessite une référence à MSCOMCTRL.OCX
 Dim lngTotal As Long, lngI As Long
 ' Initialise la barre de progression
 Load Progress
 With Progress
  .ProgressBar.Scrolling = ccScrollingStandard ' or ccScrollingSmoothMaUserForm.Show par
 .Show vbModeless ' set the UserForms ShowModal property to false before running
    ' or .Show
 'False
 End With
 UpdateProgressBar 0, "Processing..." ' Définit le statut initial
 ' démarre le processus
 lngTotal = 2000
 For lngI = 1 To lngTotal
 If lngI Mod 50 = 0 Then ' Met à jour la barre de progression toutes les 50 boucles
 UpdateProgressBar lngI / lngTotal * 100, "Processing " & Format _
    (lngI / lngTotal, "0%") & "..."
 End If
 ' Fais quelque chose ! PLACER VOTRE CODE ICI
 
 Range("D1").Formula = Format(Time, "hh:mm:ss")
 Next lngI
 
 Range("D1").ClearContent ' nettoyage
 Unload Progress
 End Sub

Private Sub UpdateProgressBar(NewValue As Single, Optional NewCaption As String)
 ' Met à jour la boite de dialogue de la progression
 With Progress
 If Not IsMissing(NewCaption) Then .Caption = NewCaption
    .ProgressBar.Value = NewValue
 If NewValue = 0 Then .Repaint
 End With
 End Sub
 
Dernière édition:

altefqhatre

XLDnaute Junior
Re : ProgressBar et UserForm

Salut :)

Merci pour ta réponse :)

Oui mais en fait quan la macro se lance, l'userform apparaît mais sans aucune couleur... comme si je lui avait mis un fond blanc et c'est tout tu vois? J'ai mis l'image en pièce jointe.

Elle apparaît en blanc mais si je stoppe la macro en cours bein la userform reprend ces couleurs... comme si elle était en arrière plan encore une fois :-(

J'ai mis également Userform.Show 0

Par contre pour le .repaint j'ai pas tout à fait compris désolé :-(


EDIT: C'est bon j'ai trouvé :p
 

Pièces jointes

  • Processing.JPG
    Processing.JPG
    4.2 KB · Affichages: 479
Dernière édition:

decid

XLDnaute Nouveau
Re : ProgressBar et UserForm

Bonjour,
Est-ce cela pourrait convenir ?
Durée à régler en fonction des volumes.

Fichier joint
bonne journée
Decid

'======================================================
Application.ScreenUpdating = False
UserForm6.BarAttente.BackColor = &HAB6429
UserForm6.BarAttente.BackStyle = fmBackStyleOpaque
n = 10
témoin = True
For w = 1 To n
P = P + 1 / n ' calcul du pourcentage
UserForm6.BarAttente.Width = P * 215
UserForm6.Caption = Format(P, "0%")
DoEvents
Next w
'======================================================
 

Pièces jointes

  • crit_ypp.xlsm
    60.9 KB · Affichages: 397

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 334
Membres
103 519
dernier inscrit
Thomas_grc11