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
| Public Sub WaitFormLoad()
Dim oProgress As clProgress
Dim lCptIteration1 As Long
Dim lCptIteration2 As Long
Dim lString As String
Const lNbIterations As Long = 4000
' Ouverture et initialisation d'un formulaire d'attente (instance de la classe clProgress)
Set oProgress = New clProgress 'ici on appelle la classe clProgress (voir module de classe correspondant)
oProgress.ProgressMin = 1 'on attribue des valeurs aux propriétés de la classe clProgress (sinon on utilisera les valeurs par défaut trouvée dans la procédure Initialize() de la classe correspondante)
oProgress.ProgressMax = lNbIterations '...
oProgress.ProgressValue = 0 '...
oProgress.GeneralInfo = "Veuillez patienter durant le traitement ... " '...
oProgress.AnimationPrefix = "ImgFrame" '...
oProgress.AnimationTimer = 500 'Lance l'animation des images (voir clProgress)
oProgress.Visible = True '...
' Boucle de traitement
For lCptIteration1 = 1 To lNbIterations
For lCptIteration2 = 1 To 1000
lString = Chr((lCptIteration1 + lCptIteration2) Mod 256)
Next
oProgress.ProgressValue = lCptIteration1 ' Met à jour la progression (voir la propriété correspondante dans la classe clProgress)
oProgress.ProgressInfo = "Traitement en cours ... " & Format(oProgress.ProgressPercent, "00%") ' Met à jour l'étiquette (voir la propriété correspondante dans la classe clProgress)
oProgress.Repaint ' Repeint le formulaire (voir la propriété correspondante dans la classe clProgress)
'oProgress.Repaint2 lCptIteration1, "Traitement en cours ... " & Format(oProgress.ProgressPercent, "00%"), "Données Articles" ' Repeint le formulaire d'attente (voir la procédure correspondante dans la classe clProgress)
Next
Set oProgress = Nothing 'destruction de l'objet oProgress de classe clProgress (=Fermeture du formulaire)
Exit Sub
Gestion_Erreurs:
If err.Source = "clProgress" Then 'Traitement spécifique pour les erreurs survenues dans la classe clProgress
Debug.Print "Erreur dans le traitement n° " & err.Number & " de la classe " & err.Source & " : " & err.Description
Resume Next 'Puis on continue le traitement
Else
MsgBox "Erreur dans le traitement n° " & err.Number & ", " & err.Description, vbCritical
End If
Set oProgress = Nothing 'destruction de l'objet oProgress de classe clProgress (=Fermeture du formulaire)
End Sub |
Partager