Bonjour,
J'utilise depuis peu les Progress bar mais les différents modèles que j'ai testés ne me convenaient pas. Soit il est intégré dans un formulaire, soit la couleur est imposée et difficilement modifiable, ... J'ai donc décidé de m'en fabriquer un simple (sans l'utilisation d'ActiveX) avec les options que je n'ai pas trouvées ailleurs :
- Pouvoir modifier facilement sa taille (longueur, hauteur) et son positionnement afin qu'il se comporte (pratiquement) comme un contrôle standard.
- Pouvoir modifier facilement sa couleur.
- Pouvoir l'intégrer et l'utiliser facilement dans un formulaire.
J'ai choisi d'utiliser un ensemble de 2 rectangles. Un rectangle extérieur qui sert de cadre fixe au 2° rectangle intérieur dont la longueur variera en fonction de sa valeur. Pour faire un ensemble cohérent, voilà comment j'ai procédé :
1 - Créer 2 rectangles avec l'outil "Rectangle"
2 - Les nommer de façon explicite (exemple : BoiteI et BoiteE).
3 - La boite Extérieure : Apparence 3D enfoncé, couleur fond (blanc, transparent ou autre)
4 - La boité Intérieur : Apparence Ciselé
(vous pouvez les paramétrer autrement mais je trouve que ça rend bien comme cela)
5 - Vous égalisez les dimensions des 2 boites, même hauteur et même largeur en utilisant les commandes classiques de mise en forme ("au plus large" et "au plus grand" par exemple)
6 - Vous superposez les 2 boites en utilisant également les commandes classiques d'alignement en prenant soin que la boite intérieure soit bien au premier plan.
7 - Vous groupez les 2 rectangles pour former un objet unique. On peut alors modifier à volonté ses dimensions et le déplacer librement sur le formulaire.
La partie graphique est terminée. Cet ensemble pourra être recopié à volonté dans d'autres formulaires ou dupliquer dans le même formulaire.
Attention de bien renommer les 2 rectangles pour pouvoir facilement les distinguer au niveau du code.
On va s'appuyer sur un module de classe pour donner des propriétés à notre objet et pouvoir les gérer plus facilement au niveau du formulaire.
Pour pouvoir générer le ProgressBar j'ai créé les propriétés suivantes :
- Valeur mini
- Valeur maxi
- Valeur actuelle
- Couleur de la barre
- Longueur maxi de la barre en twips
- Longueur actuelle de la barre
- Référence du rectangle intérieur
- Référence du rectangle extérieur
- Référence du formulaire accueillant la barre
Code complet du module de classe : clProgress
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
| Option Explicit
Private gPgBMin As Long 'Valeur Mini
Private gPgBMax As Long 'Valeur Maxi
Private gPgBValue As Long 'Valeur
Private gPgBColor As Long 'Couleur Fond
Private gPgBWidthMax As Long 'Longueur maxi en twips
Private gPgBWidth As Long 'Longueur actuelle de la barre
Private gPgBIRect As String 'Référence du rectangle intérieur (longueur variable)
Private gPgBERect As String 'Référence du rectangle extérieur (cadre fixe)
Private gPgBForm As String 'Référence du formulaire accueillant la barre
Property Get Width() As Long
Width = gPgBWidth
End Property
Property Let Width(lWidth As Long)
gPgBWidth = lWidth
End Property
Property Get WidthMax() As Long
WidthMax = gPgBWidthMax
End Property
Property Let WidthMax(lWidthMax As Long)
gPgBWidthMax = lWidthMax
End Property
Property Get Form() As String
Form = gPgBForm
End Property
Property Let Form(sForm As String)
gPgBForm = sForm
End Property
Property Get Min() As Long
Min = gPgBMin
End Property
Property Let Min(lMin As Long)
gPgBMin = lMin
End Property
Property Get Max() As Long
Max = gPgBMax
End Property
Property Let Max(lMax As Long)
gPgBMax = lMax
End Property
Property Get Color() As Long
Color = gPgBColor
End Property
Property Let Color(lColor As Long)
gPgBColor = lColor
Forms(Me.Form).Controls(Me.IRect).BackColor = Me.Color 'Lorsque la couleur est mise à jour dans l'objet on modifie la couleur du rectangle intérieur
End Property
Property Get IRect() As String
IRect = gPgBIRect
End Property
Property Let IRect(sRect As String)
If Forms(Me.Form).Controls(sRect).ControlType = acRectangle Then 'On vérifie que l'objet affecté est bien un rectangle
gPgBIRect = sRect 'On affecte alors l'objet Rectangle Intérieur à l'objet ProgressBar
Else
err.Raise Number:=vbObjectError + 1, Description:="Objet affecté non valide"
End If
End Property
Property Get ERect() As String
ERect = gPgBERect
End Property
Property Let ERect(sRect As String)
If Forms(Me.Form).Controls(sRect).ControlType = acRectangle Then 'On vérifie que l'objet affecté est bien un rectangle
gPgBERect = sRect 'On affecte alors l'objet Rectangle Extérieur à l'objet ProgressBar
Me.WidthMax = Forms(Me.Form).Controls(Me.ERect).Width 'On affecte la longueur maxi (celle du rectangle extérieur) à l'objet
Else
err.Raise Number:=vbObjectError + 1, Description:="Objet affecté non valide"
End If
End Property
Property Get Value() As Long
Value = gPgBValue
End Property
Property Let Value(lValue As Long)
Dim intVal As Double
Dim doFact As Double
doFact = (Me.WidthMax) / (Me.Max - Me.Min)
intVal = doFact * (lValue - Me.Min) 'Calcul en twips de la longueur du rectangle variable (intérieur)
gPgBValue = lValue
Me.Width = intVal 'Affectation de la longueur du rectangle intérieur à l'objet
Forms(Me.Form).Controls(Me.IRect).Width = Me.Width 'Modification de la longueur du rectangle intérieur du formulaire
Forms(Me.Form).Repaint
DoEvents
End Property |
Le ProgressBar est initialisé dans le formulaire principal
Dans l'entête du code du formulaire
1 2 3
| Option Compare Database
Dim lPgB, lPgB1 As clProgress |
J'ai initialisé içi 2 objets
Ensuite au niveau de l'utilisation (c'est un exemple):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
| Private Sub Visu_Forms()
Dim cnt As DAO.Container
Dim Doc As DAO.Document
Set db = CurrentDb
' Visualisation de tous les formulaires
Set cnt = db.Containers("Forms")
Set lPgB = oPgB(Me.Form, Me.BoitI, Me.BoitE)
lPgB.Min = 0
lPgB.Max = cnt.Documents.Count
lPgB.Color = vbBlue
lPgB.Value = 0
For Each Doc In cnt.Documents
Debug.Print Doc.Name, Doc.Container
lPgB.Value = lPgB.Value + 1
Next Doc
Set cnt = Nothing
Set lPgB = Nothing
Set db = Nothing
End Sub |
Revenons sur la ligne :
Set lPgB = oPgB(Me.Form, Me.BoitI, Me.BoitE)
C'est elle qui crée l'objet à l'aide d'une fonction inscrite dans un module :
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
| Function oPgB(frm As Form, oIRect As Rectangle, oERect As Rectangle) As clProgress
On Error GoTo Erreur
Set oPgB = New clProgress
With oPgB
.Form = frm.Name
.IRect = oIRect.Name
.ERect = oERect.Name
End With
Exit Function
Erreur:
MsgBox err.Description & " Erreur lors de la création de l'objet", vbExclamation + vbOKOnly, "Erreur d'affectation"
Set oPgB = Nothing
End Function |
Les paramètres de cette fonction sont :
- la référence du formulaire actuel
- les références des 2 boites (intérieure et extérieure)
La fonction créé et affecte localement une instance de l'objet clProgress et lui affecte les 3 propriétés essentielles :
- Le nom du formulaire appelant
- Le nom de la boite intérieure
- Le nom de la boite extérieure
La fonction renvoie la référence de l'objet créé qui est lui même affecté à la variable locale afin de pouvoir être exploité par le code du formulaire appelant.
En cas de passage d'un objet autre qu'un rectangle la fonction se met en erreur lors de la vérification des types des arguments d'entrée. En cas d'erreur dans le module de classe, l'erreur est gérée.
Voilà c'est pratiquement terminé. L'objectif est atteint :
- Les parties ardues du code sont dans le module de classe et dans le module, elles sont donc transparentes dans l'utilisation du formulaire
- Les appels des propriétés sont simples et pratiquement similaires à celles que l'on a avec un ActiveX.
- Les dimensions du ProgressBar sont facilement modifiables
- On peut facilement ajouter d'autres fonctionnalités (exemples :couleur du fond du rectangle extérieur, ajout de texte à l'intérieur du rectangle, ...)
Le code n'est pas vraiment optimisé mais je compte sur vous pour le rendre encore meilleur.
Cordialement,
Partager